Hirdetés
- Konvektor korszerűsítés - Computherm KonvekPRO felszerelése Q7RF szobatermosztát
- Öregszem
- Szólánc.
- GPU-k mindörökké - a kezdetek?
- Airfryer XL XXL forrólevegős sütő gyakorlati tanácsok, ötletek, receptek
- eBay-es kütyük kis pénzért
- Fűzzük össze a szavakat :)
- Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- Asszociációs játék. :)
- Milyen mosógépet vegyek?
-
LOGOUT.hu
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
hallgat
csendes tag
válasz
hallgat
#13821
üzenetére
Sziasztok!
Egyszerűsödött a kérdésem.
Delila leírása szerint meghatároztam usor néven az utolsó sor értékét.
Most szeretném VBA kódban kijelölni a "B2:Busor" területet, csak nem megy, mert béna vagyok
Köszi!!
[ Szerkesztve ]
Office 2010 Attól, hogy a verebek alakzatba állnak, az még nem SAS!
-
Delila_1
veterán
-
hallgat
csendes tag
válasz
hallgat
#13831
üzenetére
Ami számomra még furcsa, hogy ha makró rögzítővel kézzel megcsinálom a műveletet és ezt illesztem be a kódba, akkor ugyan az marad a szintaktika, csak a
Range("L21:L" & usor).Select
helyett a jelenlegi adatok mennyisége miatt ez lesz:
Range(L21:L286).Selectami szintén nem fut le, ugyan ennél a sornál leáll.
Pedig ezt a sajár makrórögzítője csinálta
Office 2010 Attól, hogy a verebek alakzatba állnak, az még nem SAS!
-
Delila_1
veterán
válasz
hallgat
#13831
üzenetére
Ha a Munka2 lap L oszlopának az aljára akarod bemásolni ismételten a Munka1!B1:T1 tartományát, akkor az usor változót ehhez kell igazítani.
Sub mm()
Dim usor As Integer
'Munka1!B1:T1 másolása a Munka2!L2-be transzponálva
Sheets("Munka1").Range("B1:T1").Copy
Sheets("Munka2").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlValues, Transpose:=True
'usor az L oszlopban a Munka2 lapon
usor = Range("L65536").End(xlUp).Row
'másolás az utolsó alatti sorba, transzponálva
Range("L" & usor + 1).Select
Selection.PasteSpecial Paste:=xlValues, Transpose:=True
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
veterán
válasz
hallgat
#13831
üzenetére
Ha a Munka2 lap L oszlopának az aljára akarod bemásolni ismételten a Munka1!B1:T1 tartományát, akkor az usor változót ehhez kell igazítani.
Sub mm()
Dim usor As Integer
'Munka1!B1:T1 másolása a Munka2!L2-be transzponálva
Sheets("Munka1").Range("B1:T1").Copy
Sheets("Munka2").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlValues, Transpose:=True
'usor az L oszlopban a Munka2 lapon
usor = Range("L65536").End(xlUp).Row
'másolás az utolsó alatti sorba, transzponálva
Range("L" & usor + 1).Select
Selection.PasteSpecial Paste:=xlValues, Transpose:=True
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
#13924
Fire/SOUL/CD
félisten
hallgat
#13923
válasz
hallgat
#13923
üzenetére
Feltétlenül makró kell hozzá? Mert ha nem, akkor csak leszűröd a listát, hogy csak a 0 és üres sorokat szűrje, majd egérrel kijelölöd a szűrt sorokat, jobb egér/Sor törlése.
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
#13926
Fire/SOUL/CD
félisten
hallgat
#13925
-
#13928
Fire/SOUL/CD
félisten
hallgat
#13927
válasz
hallgat
#13927
üzenetére
Ha megoldható, tedd fel valahova a munkafüzetet, ahonnan letölthetem, akkor megnézem. Így én is csak csalamádét látok, töredékét a makró(k)nak.
[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
#13930
Fire/SOUL/CD
félisten
hallgat
#13929
válasz
hallgat
#13929
üzenetére
Sheets("Munka1").Range("B1:T1").Copy
Sheets("Munka2").Range("L2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
usor = Sheets("Munka2").Range("A1").End(xlDown).Row
Sheets("Munka2").Activate
Sheets("Munka2").Range("L2:L20").Copy
Sheets("Munka2").Range("L21:" & "L" & usor).Select
ActiveSheet.Paste
Application.CutCopyMode = False
usor = Sheets("Munka2").Range("A1").End(xlDown).Row
Sheets("Munka2").Range("L" & usor).Select
Dim i As Integer
For i = usor To 2 Step -1
If IsEmpty(Sheets("Munka2").Cells(i, 14)) Or (Sheets("Munka2").Cells(i, 14)) = 0 Then
Sheets("Munka2").Rows(i).Delete
End If
Next iMindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
hallgat
csendes tag
válasz
hallgat
#13954
üzenetére
Közben meg van a megoldás, vagy legalább is egy működő képlet...
Hátha segít valakinek, aki hasonló dolgot keres:
=INDEX(Munka2!A:T;HOL.VAN(A2;Munka2!$A:$A;0);HOL.VAN(B2;Munka2!$A$1:$T$1;0))
A fügvény így a Munk2 lapon A:T tartományban lévő sor és oszlop metszéspont értékét adja eredményül, a Munka1 A2 és B2 celláinak értékeire keresve.
Munka1 A2 cellájában lévő értéket keresi Munka2 A oszlopában és a sor számát adja vissza,
majd Munka1 B2 értékét keresi Munka2 A1:T1 tartományában és az oszlop értéket adja
vissza az INDEX függvénynek.Lehet csak nekem újdonság, de ez nagyjából az FKERS és a VKERES funkcióinak az összefűzése.
Office 2010 Attól, hogy a verebek alakzatba állnak, az még nem SAS!
-
#90999040
törölt tag
válasz
hallgat
#14093
üzenetére
Próbáld meg így:
n = Range("A" & Rows.Count).End(xlUp).Row
For i = n - 1 To 1 Step -1
If Cells(i, 1).Value <> Cells(n, 1).Value Then
If i < n - 1 Then Rows(i + 1 & ":" & n - 1).Delete
n = i
End If
Next
If Cells(1, 1).Value = Cells(n, 1).Value And n > 1 Then Rows(1 & ":" & n - 1).Delete -
cousin333
addikt
válasz
hallgat
#14093
üzenetére
Mindenképpen az egész sor törlése kell, nem csak egy adott mennyiségű oszlopé?
A sebesség azért lassú, mert sokszor nyúlsz a cellákhoz. Ilyen adatmennyiségnél ez már komoly problémát jelent.
Azt írtad, hogy az ismétlődések csak egymás után fordulnak elő. Akkor egyszerűen menj végig az oszlopon, és ha az aktuális cella megegyezik az előző cellával, akkor töröld ki az adott sort. Csak arra figyelj, hogy legközelebb is ugyanezt a sort vizsgáld, mert a törlés miatt eggyel kevesebb lett. Vagy alulról indulj el felfelé.
[ Szerkesztve ]
"We spared no expense"
-
cousin333
addikt
válasz
hallgat
#14093
üzenetére
Na, megalkottam a gyilkos VBA kódot
Nyilván lehetne még rajta reszelni, de úgy tűnik, működik, méghozzá elég gyorsan. A kód feltételezi, hogy a kérdéses számok az A1:A20000-es tartományban vannak. Akkor is így kell megadni, ha a számok csak a 2. sorban kezdődnek! Ha nem az első sorból indítasz, akkor módosítgatni kell a kódot, mert nálam a tartomány indexe és a sor száma ugyanaz (lásd a For ciklust).Gyakorlatilag megnézem a teljes listát, és ha azonosat találok, megjelölöm azzal, hogy törlöm a mellette(!) lévő cella tartalmát (különben csak minden 2. egyezést találna meg). A törlést nem a munkafüzeten végzem, mert az ennyi adatnál lassú lenne, hanem "belsőleg".
Ezután fogom a teljes tartományt, és kijelölöm illetve törlöm azokat a sorokat, amiben a B cella üres. A kód:
Sub duplikatum()
Dim szamok As Variant
szamok = Range("A1:B20000").Value
sorok = ""
For i = 2 To UBound(szamok)
If szamok(i, 1) = szamok(i - 1, 1) Then
szamok(i, 2) = ""
End If
Next i
Range("A1:B20000").Value = szamok
Range("B1:B20000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub[ Szerkesztve ]
"We spared no expense"
-
cousin333
addikt
válasz
hallgat
#14107
üzenetére
Tulajdonképpen a kódja nem egyenként töröl, legalábbis nem soronként, hanem kihasználja azt az adottságot, hogy az ismétlődések egymás után szerepelnek. Megkeresi a teljes ismétlődő blokkot és egy lépéssel törli. A sebesség tehát inkább a blokkok számától függ, mintsem a benne lévő ismétlődő sorok számától.
[ Szerkesztve ]
"We spared no expense"
-
cousin333
addikt
válasz
hallgat
#14105
üzenetére
Igen, a kódomat írva nekem is az volt a legfőbb gondom, hogy hogyan lehetne gyorsan törölni, Szerencsére rátaláltam arra az utasításra, ami képes kijelölni az üres cellákat. Innen már csak üressé kellett tennem a megcélzott elemeket, az meg ment gyorsan.
De egyébként a fenti problémára van jobb megoldás is, nem tudom, a 2003-ban megy-e:
- jelöld ki a teljes táblázatot: Ctrl + Shift + Space (ez is jó trükk amúgy)
- Adatok fül, Adateszközök, Ismétlődések eltávolítása
- kiválasztod az oszlopo(ka)t, amik alapján az ismétlődést megállapítodennyi...
[ Szerkesztve ]
"We spared no expense"
-
#90999040
törölt tag
válasz
hallgat
#14111
üzenetére
Azért annyi, mert a cellából/ba olvasás/írás nagyon lassú művelet.
Ha viszont a memóriába olvasod be "tömbként", azon sokkal gyorsabb maga a művelet sebessége, viszont így a memóriahasználat sokkal nagyobb. De hát ugye valamit valamiért.
Még lehetne úgy is, hogy a táblázathoz egy plusz oszlopot átmenetileg hozzáadni, ebben megjelölni a megmaradó cellákat, majd sorba rendezni. Ezután megkeresni ebben az új oszlopban az első nem üres cellát, majd a táblázat sorainak a celláit innentől kezdve törölni. Majd a végén az új oszlop celláit is törölni:
Application.ScreenUpdating = False
Set elsoadat = Range("A2")
Set rng = elsoadat.CurrentRegion
If rng.Row < elsoadat.Row Then Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count)
n = Cells(Rows.Count, rng.Column).End(xlUp).Row
tomb = Application.Transpose(Range(Cells(rng.Row, rng.Column), Cells(n, rng.Column)).Value)
ReDim tomb1(1 To UBound(tomb))
n = UBound(tomb)
tomb1(n) = 1
For i = n - 1 To 1 Step -1
If tomb(i) <> tomb(n) Then
tomb1(i) = 1
n = i
End If
Next
n = UBound(tomb)
Range(Cells(rng.Row, rng(rng.Count).Column + 1), Cells(rng(rng.Count).Row, rng(rng.Count).Column + 1)).Value = Application.Transpose(tomb1)
Range(Cells(rng.Row, rng.Column), Cells(rng.Row + n - 1, rng(rng.Count).Column + 1)).Sort Key1:=Cells(rng.Row, rng(rng.Count).Column + 1), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
m = Cells(Rows.Count, rng(rng.Count).Column + 1).End(xlUp).Row
Range(Cells(m + 1, rng.Column), Cells(rng.Row + n - 1, rng(rng.Count).Column + 1)).Delete
Range(Cells(rng.Row, rng(rng.Count).Column + 1), Cells(m, rng(rng.Count).Column + 1)).Delete
Set rng = ActiveSheet.UsedRange
Application.ScreenUpdating = TrueItt a elsoadat-ban kell megadni az első olyan adatot tartalmazó cellát, amelytől lefelé az ismétlődéseket figyelni kell. Előnye, hogy csak egy oszlopot ír(bár 2-t olvas be, valamint autómatikusan érzékeli a fejlécet is, ha a elsoadat jól van megadva, tehát a táblázat igazából bárhol lehet, nem csak az A2-ben.
-
#16812
m.zmrzlina
senior tag
hallgat
#16810
-
Mutt
senior tag
válasz
hallgat
#18101
üzenetére
Hello,
A nevesített cellákra makróban az alábbi módokon tudsz hivatkozni:
Range("ALPHA_2X2")
[ALPHA_2X2]A lenti makró az ALPHA_2X2, 2X3 és 2X4 nevű cellák tartalma alapján vagy adja a felugró ablakot, vagy futtatja a kódodat. Ha legalább az egyik cella üres, akkor leáll, vagyis csak akkor enged tovább ha minden mezőben van vmi (hogy az szám, szöveg, képlet stb. nem nézi).
Sub Elagazas()
Dim blnUres As Boolean
Dim cell As Range
blnUres = False
For Each cell In Range("ALPHA_2X2, ALPHA_2X3, ALPHA_2X4")
If IsEmpty(cell.Value) Then blnUres = True
Next cell
If blnUres Then
MsgBox "Hiányzó értékek!", vbOKOnly, "Hiba"
Else
'ide jön az eredeti kódod
End If
End SubEbből tudsz építkezni ha nem lenne elég.
üdv.
A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
-
-
hallgat
csendes tag
válasz
hallgat
#18947
üzenetére
Sziasztok!
Sikerült túlesnem a szintaktikai bénázáson
, DE...Tudtok erre gyorsabban lefutó megoldást?
Ez így már tisztességes ideig elszórakozik egyetlen oszloppal is, nem 190-nel
Sub Makró1()
Dim o As Integer
Dim s As Integer
For o = 190 To 2 Step -1
For s = 1422 To 3 Step -3
Sheets("Munka2").Cells(s, o).Select
If IsEmpty(Sheets("Munka2").Cells(s, o)) Or (Sheets("Munka2").Cells(s, o)) = 0 Then
Sheets("Munka2").Range(Cells(s, o), Cells(s - 2, o)).Delete Shift:=xlToLeft
End If
Next s
Next o
End SubKöszi!!!
Office 2010 Attól, hogy a verebek alakzatba állnak, az még nem SAS!
-
#18981
m.zmrzlina
senior tag
hallgat
#18980
m.zmrzlina
senior tag
válasz
hallgat
#18980
üzenetére
Nézd át ezt az oldalt! Főleg attól a résztől, hogy: Read/Write Large Blocks of Cells in a Single Operation
Esetleg ez is segíthet. Vagy ez.
Szerintem nem fogod megúszni a tömbök használatát.
[ Szerkesztve ]
-
Delila_1
veterán
válasz
hallgat
#18980
üzenetére
Már az sokat gyorsít, ha a
Sheets("Munka2").Cells(s, o).Select
sort kihagyod. Nem szükséges ráállnod a cellára a törléshez.
A képernyőfrissítést is kapcsold ki a futás idejére, ahogy m.zmrzlina javasolta.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
#18985
m.zmrzlina
senior tag
hallgat
#18983
m.zmrzlina
senior tag
válasz
hallgat
#18983
üzenetére
A két egymásba ágyazott ciklusban kb 95000 olvasás-írás van. ((1400/3)*190) ez rengeteg időt visz el. Nem a belső ciklusban lévő kiértékelés a sok hanem a feladat végrehajtása a 95000-szeri olvasás-írás. Ezen már csak apró szépségtapasz az egy felesleges sor kihagyása és az Application.ScreenUpdating=False(True) bár néha ez is tud látványos eredményt hozni.
Esetleg a For-Each-Next használata a For-Next helyett segíthet valamit.
A tömböket... No igen, egyszer rá kéne már szánni magam.
Van az a feladat amikor nem tudod megkerülni.
-
Mutt
senior tag
válasz
hallgat
#18980
üzenetére
Hello,
A megoldásom egy másik módszert használ, az eredeti lapból csak a hasznos (ahol a cella nem üres vagy 0) adatokat átemeli egy másik lapra (a neve output, de lent állíthatod ezt).
Egyszerre 3 sor hasznos adatát egy tömbben tárolja. A sor végén pedig kiíratja a másik lapra a tömböt. Utána 3 sorral feljebb megy és azon is végig megy és kiír.
Nekem 11-16 másodperc alatt lefut egy 1422x190-es táblán, remélem nálad is rendben fog menni.
Kommenteltem, hogy könnyen javítható legyen.Sub Torol3asaval()
Dim arrEredmeny() 'dinamikus tömb az értékek tárolásához
Const LastRow As Integer = 1422 'utolsósor
Const LastColumn As Integer = 190 'utolsóoszlop
Dim vRow As Long 'változó a vizsgált sorok nyomonkövetéséhez
Dim vColumn As Long 'változó a vizsgált oszlopok nyomonkövetéséhez
Dim vHits As Long 'változó a soronként a feltételeknek megfelelő eredményekhez
Dim i As Long
Dim vStartTime
Dim wsOutput As Worksheet
Const wsName As String = "output" 'ide tesszük az eredményt
Dim wsActiveSheet As String
'nézzük meg mennyi idő alatt fut le
vStartTime = Time
'elmentjük az eredeti lapot
wsActiveSheet = ActiveSheet.Name
'megnézzük hogy van-e a keresett névvel munkalap a füzetben
For i = 1 To Sheets.Count
If Sheets(i).Name = wsName Then vHits = 1
Next i
'ha nincs akkor létrehozzuk a lapot, különben megnyitjuk
If vHits <> 1 Then
Set wsOutput = Sheets.Add
wsOutput.Name = wsName
Else
Set wsOutput = Sheets(wsName)
wsOutput.Cells.Clear
End If
'visszamegyünk az eredti lapra
Sheets(wsActiveSheet).Activate
'kikapcsoljuk a képernyő frissítést hogy gyorsabb legyen
Application.ScreenUpdating = False
'utolsó sortól elindulunk vissza
For vRow = LastRow To 1 Step -3
'töröljük a tömb tartalmát
Erase arrEredmeny
'ide gyűjtük hogy hány oszlop van ahol nem üres vagy 0 van az utolsó sorban
vHits = 0
'végig megyünk a sor oszlopain
For vColumn = 1 To LastColumn
'ha az érték nem üres vagy nulla akkor egy tömbbe elmentjük a sor és feletti 2 értéket
If Cells(vRow, vColumn).Value <> 0 And Cells(vRow, vColumn).Value <> "" Then
'növeljük a sikeres találatok számlálóját
vHits = vHits + 1
'átméretezzük a tömböt hogy új találatokat is tudjon tárolni
ReDim Preserve arrEredmeny(1 To 3, 1 To vHits)
arrEredmeny(1, vHits) = Cells(vRow - 2, vColumn).Value
arrEredmeny(2, vHits) = Cells(vRow - 1, vColumn).Value
arrEredmeny(3, vHits) = Cells(vRow, vColumn).Value
End If
Next vColumn
'kiírjuk a találatokat, ha van mit
If vHits Then
'az első 3 sor elé újabb 3 sort szúrunk be
wsOutput.Rows("1:3").Insert Shift:=xlDown
For i = 1 To vHits
With wsOutput
'az első 3 sorba beírjuk a korábbi találatokat
.Cells(1, i) = arrEredmeny(1, i)
.Cells(2, i) = arrEredmeny(2, i)
.Cells(3, i) = arrEredmeny(3, i)
End With
Next i
End If
Next vRow
'visszakapcsoljuk a frissítést
Application.ScreenUpdating = True
Debug.Print "Futási idő: " & Format(Time - vStartTime, "s") & " sec"
End Subüdv
A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
-
Simba86
senior tag
válasz
hallgat
#19534
üzenetére
köszönöm neked is!
(ez a pénztárkönyvesdi még új nekem, keveset könyveltem így, de a 2 tétel úgy értendő, hogy mondjuk egy tescós számlán van 18 és 27-es áfás tétel is, de attól az még egy számla
)de ha rosszul tudom, javítsd ki persze!
szerencsére a cégeket könyvelhetem programmal, bele is bolondulnék nélküle...
Siemens C35-> Siemens MT50-> Motorola E398-> SE K750i-> Nokia 6220 Classic-> ZTE Blade-> SE Xperia Mini Pro-> Samsung Galaxy S Advance -> Sony Xperia SP -> Huawei P8 Lite -> Xiaomi Redmi Note 4 -> Xiaomi Redmi Note 6 Pro ->Xiaomi Redmi Note 9 -> Xiaomi Redmi Note 11
-
Mittu88
senior tag
válasz
hallgat
#19546
üzenetére
Köszi szépen mindkettőtöknek a segítséget. A kimutatást hétvégén próbálgatom majd (most is melóból érek, úgyhogy nagyon nem érek rá), kb 3 percet tudtam "játszani" vele, de tetszik
Amúgy ez a dinamikus adatérvényesítés az, amit keresek. Kicsi az adatbázis, úgyhogy ez lesz a befutó
Még egyszer köszi
-
Delila_1
veterán
válasz
hallgat
#19549
üzenetére
Makró nélkül is csak 1-2 kattintás. Beírod egy üres cellába a szorzót, és Ctrl+c-vel másolod. Kijelölöd a szorzandó területet. Jobb, klikk, irányított beillesztés, szorzás. A szorzó törölhető a művelet végrehajtása után.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Grodd
tag
válasz
hallgat
#30556
üzenetére
Igen, sajnos nagyon ismerös a probléma. Rengeteget szenvedt vele, mire rájöttem, hogy sajnos ez nem oldható meg MS queryben, mert nem lehet sehogy sem tömböt átadni paraméterként. Hidd el, tényleg nem lehet, rengeteg idöt elcsesztem vele, de nincs megoldás. Excel 2016 get&transform vagy korábbi excelben powerquery az egyetlen megoldás erre, ha érdekel, megírom.
-
Grodd
tag
válasz
hallgat
#30560
üzenetére
Hát azért az olyan sztenderd Microsoft-os excel kiegészítőket, mint PowerQuery, PowerPivot általában vállalati környezetben is engedélyezni szokták, sőt, szerencsére ma már ezek alapból telepítve vannak a vállalati gépeken jobb helyeken (ahol még nem migráltak Office 365-re, vagy Office 2016-ra, mert azokba már alapból be van integrálni, nem kell semmit telepíteni)
Ha a PowerPivotot kiszemelted agadnak, és hízelegsz az érdekében, akkor már tetesd már fel egyúttal a PowerQuery-t is. Amit PPivotban meg lehet oldani, azt PQuery-ben is, csak sokkal szebben, gyorsabban, és egyszerűbben
Nomeg a PPivotot még 2013-ben és 2016-ban is külön kell telepíteni (igaz, Pro Plus csomagban benne van, de akkor is külön kell telepíteni a kiegészítőt) Sőt, 2013-tól PPivot csak Pro Plushoz érhető el, annál kisebb SKU-khoz még ingyenes letöltés formájában sem érhető el (csak Office 2010-hez)
a PowerQuery viszont már be van teljesen integrálva a mai excelbe (az összesbe, nem csak Pro-ba). Persze nagyvállalati környezetben előfordulhatnak bizonyos extrém esetek, amit PowerPivotban egyszerűbb megoldani, mint PQueryben, de az ritka, mint a fehér hollóHa makró is járható út , (azt hittem anélkül akarod/kell megoldani) akkor van más módja szerintem akár annak is, hogy beolvasd a range-ből egy tömbbe az adatokat, és ezt a tömböt kiírd egy sztringbe, amit aztán átadhatsz paraméterként a MS querynek.
Ha mégsem, akkor magát az SQL query-t magát szerkesztheted. Nem kell feltétlenül feltölteni a táblát az SQL serverre. Itt nézelődhetsz:
http://stackoverflow.com/questions/27385245/using-excel-vba-to-run-sql-query
-
hallgat
csendes tag
válasz
hallgat
#31205
üzenetére
Sziasztok!
Sikerült nagyban könnyítenem a helyzeten, de a megoldás makróval nekem még így is távoli.
Mát csak 2 oszlopom van.
A oszlopban csoport ID-k, ismétlődésekkel.
B oszlopban jellemző ID-k ismétlődésekkel.
Nagyjából így:
Amit el kéne érnem, hogy egy másik munkalapon legyen egy listám, hogy melyik jellemző melyik csoportban szerepel.
A kezdő képből ez lenne a végeredmény:
A makrónak azt kellene megoldania, hogy a kiinduló állapotban elindul Munka1!B2 cellánál, értékét beteszi Munka2!A2 cellájába és B2-be beírja Munka1!A1 értékét. Továbblép lefelé, ha Munka1!B3 tartalma egyezik Munka1B2-vel, akkor Munka2!A2 változatlan marad, de Munka2!B2 értékéhez hozzáteszi egy vesszővel elválasztva Munka1!A3 értékét.
Továbblép. Ha Munka1!Bn értéke más lesz, mint Munka1!Bn-1, akkor Munka2!A következő üres cellájába beírja Munka1Bn értékét, mellé pedig Munka1!An értékét és így tovább.Ha ebben tudna valaki...
Köszi!
Office 2010 Attól, hogy a verebek alakzatba állnak, az még nem SAS!
-
Delila_1
veterán
válasz
hallgat
#31233
üzenetére
Készíts egy másolatot a B oszlopról a D-be. Ebben az oszlopban Ismétlődések eltávolítása. Az E oszlopot állítsd szöveg formátumúra. Indulhat a makró.
Sub Ismetlodes()
Dim sorB As Long, sorD As Long, sorE As Long
Dim usorD As Long, usorB As Long
usorD = Range("D" & Rows.Count).End(xlUp).Row
usorB = Range("B" & Rows.Count).End(xlUp).Row
sorE = 2
For sorD = 2 To usorD
For sorB = 2 To usorB
If Cells(sorB, "B") = Cells(sorD, "D") Then Cells(sorE, "E") = Cells(sorE, "E") & "," & Cells(sorB, "A")
Next
Cells(sorE, "E") = Right(Cells(sorE, "E"), Len(Cells(sorE, "E")) - 1)
sorE = sorE + 1
Next
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
veterán
válasz
hallgat
#36572
üzenetére
Jelöld ki a tartományt, majd futtasd az alábbi, modulba másolt makrót:
Sub NoPiros()
For Each CV In Selection
If CV.Interior.ColorIndex = 3 Then
Range(CV.Address).Delete shift:=xlToLeft
End If
Next
End SubAhol egymás mellett több piros hátterű cella is van, a második megmarad, újbóli futtatás rendbe teszi.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
veterán
válasz
hallgat
#36579
üzenetére
Az Immediate ablakba (Ctrl+g-re bújik elő a VB szerkesztőben) írd be:
?activecell.interior.colorindex
Nekem van egy kis makróm a personalban (lásd a téma összefoglalót), amihez a gyorselérési eszköztárra kitettem egy ikont. Ez egy üzenetben megadja a háttér és a font színkódját, RGB-ben is.
Sub Szin_lekerdezes()
Dim Rh As Integer, Gh As Integer, Bh As Integer
Dim Rk As Integer, Gk As Integer, Bk As Integer
Dim hatter, karakter
hatter = Selection.Interior.Color
karakter = Selection.Font.Color
Rh = hatter Mod 256
Gh = (Int(hatter / 256)) Mod 256
Bh = Int(hatter / 256 ^ 2)
Rk = karakter Mod 256
Gk = (Int(karakter / 256)) Mod 256
Bk = Int(karakter / 256 ^ 2)
MsgBox "Háttér RGB: " & Rh & ", " & Gh & ", " & Bh & vbLf & _
"Karakter RGB: " & Rk & ", " & Gk & ", " & Bk & vbLf & vbLf & _
"Háttér színkód: " & Selection.Interior.ColorIndex & vbLf & _
"Karakter színkód: " & Selection.Font.ColorIndex
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
Nyilván lehetne még rajta reszelni, de úgy tűnik, működik, méghozzá elég gyorsan. A kód feltételezi, hogy a kérdéses számok az A1:A20000-es tartományban vannak. Akkor is így kell megadni, ha a számok csak a 2. sorban kezdődnek! Ha nem az első sorból indítasz, akkor módosítgatni kell a kódot, mert nálam a tartomány indexe és a sor száma ugyanaz (lásd a For ciklust).
, DE...
Új hozzászólás Aktív témák
Hirdetés
Fferi50
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, kedvező ár!
- Star Wars Outlaws GeForce RTX 40 Bundle - lepd meg magad!
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- Game Pass Ultimate előfizetések 1 - 19 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Windows 7 Home Premium, Pro, Ultimate és Windows 8, 8.1 Pro licenckulcsok 64, 32 bit - MEGA Akciók!
- Windows Server 2016, 2019, 2022 Standard, Datacenter, Essentials termékkulcsok - MEGA akció!
- Új Windows 7, 8.1, 10, 11 telepítő pendrive-ok, pendrájvok és telepítőlemezek, DVD-k
- 3 havi XBOX GAME PASS Ultimate PC-re Xboxra
- Casino Deluxe 2(Sierra) pc játékszoftver
Állásajánlatok
Cég: HC Pointer Kft.
Város: Pécs
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest