-
Fototrend
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
-
Delila_1
veterán
válasz
slashing
#23720
üzenetére
Nem teljesen olyan, mint a képen, de hasonlít.
Ha kevesebb dolgom lesz, megpróbálom azt a formát kihozni.Sub Oszlopok()
Dim WS1 As Worksheet, WS2 As Worksheet, sor As Long, usor As Long
Dim oszlop As Integer, uoszlop As Integer, cim As String, oszlophova As Integer
Dim WF As WorksheetFunction, sorhova As Long
Set WS1 = Sheets("Munka1")
Set WS2 = Sheets("Munka2")
Set WF = Application.WorksheetFunction
sor = 1
WS1.Select
Do While Cells(sor, 1) <> ""
uoszlop = WS1.Range("A" & sor).End(xlToRight).Column
For oszlop = 1 To uoszlop
cim = Cells(sor, oszlop)
On Error GoTo Tovabb
oszlophova = WF.Match(cim, WS2.Rows(1), 0)
Cells(sor + 1, oszlop).Select
usor = Selection.End(xlDown).Row
sorhova = WS2.Cells(Rows.Count, oszlophova).End(xlUp).Row + 1
Range(Cells(sor + 1, oszlop), Cells(usor, oszlop)).Copy WS2.Cells(sorhova, oszlophova)
Tovabb:
On Error GoTo 0
Next
sor = Range("A" & sor).End(xlDown).Row
sor = Range("A" & sor).End(xlDown).Row
Loop
End Sub -
Fferi50
Topikgazda
válasz
slashing
#23720
üzenetére
Szia!
Most ellenőriztem, sajnos a speciális szűrés nem megy, mert ha nincs olyan fejléc a szűrendő mezőben, akkor hibát dob (bár nem egészen értem a logikáját, hogy miért, de ez van, ezt kell elfogadni.)
Másik ötlet:
Képlet szinten: Hol.van függvénnyel meghatároznám, hogy az adott fejléc hanyadik oszlopban van a másik táblában és abba az oszlopba kell tenni az adatot. (Nyilván ezt le lehet makróval rendezni (match függvény)).
Tehát: kb.így nézne ki
set mlap1=workbooks("Munkafüzet3").sheets("Munka1")
set mlap2=workbooks("Munkafüzet4").sheets("Munka1")
itt kezdheted az oszlopok ciklusát
oszlop=application.match(mlap1.range("A1").value;mlap2.rows('"1:1"),0)
if not iserror(oszlop) then ' ez csak azért kell, ha mégsem lenne olyan fejléc a másik munkalapon
yy=mlap.cells(40000,oszlop).end(xlup).row+1
for xx=2 to mlap1.range("A2").end(xldown).row
mlap2.cells(yy,oszlop).value=mlap1.cells(yy,"A").value
yy=yy+1
next
else
msgbox "Nincs ilyen fejléc: " & mlap1.range("A1").value
endif
next oszlopokA makró csak szemléltető, nem feltétlenül hibátlan.
Ezt végigcsinálod minden oszlopon, és minden kis táblán.
Ha deklarálod a változókat, az oszlop mindenképpen variant legyen, mert annak értéke hiba is lehet, mint látod.Remélem érthető és tudod használni.
Üdv.
-
slashing
senior tag
válasz
slashing
#23720
üzenetére
Amúgy én úgy képzelem/képzeltem el hogy először megkerestetem a célfájl azon sorát amiben a legtovább van adat ezt eltározom egy változóban sorazonosítóként aztán van egy ciklusom ami végigfut az első tábla fejlécsorán mégpedig úgy hogy csinál egy keresést a másik fájl fejlécében és ahol megtalálja az egyezőt ott eltározom az oszlop azonosítót ha ez meg van akkor van egy sor és oszlopazonosítom ahova bemásolhatja az adatokat. Arra mondjuk figyelni kell hogy a sorazonosító ne legyen ciklusban nehogy lépcsős legyen az egész. Így leírva milyen egyszerű
Új hozzászólás Aktív témák
- Nem akármilyen új GeForce jöhet idén
- Beperelte a BYD Amerikát
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Intel Core Ultra 3, Core Ultra 5, Ultra 7, Ultra 9 "Arrow Lake" LGA 1851
- The Elder Scrolls V: Skyrim
- Milyen légkondit a lakásba?
- Ez a pehelysúlyú egér talán még egy jeti kezébe is passzol
- Egy jó kis májusi horror aranyat ér, végre befut a Directive 8020
- Futball Vintage - foci és más sport-ereklyék topicja
- Cisco vizsgák (CCNA, CCNP, CCIE)
- További aktív témák...
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- The Elder Scrolls Online Imperial Collector s Edition
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- iKing.Hu - Samsung Galaxy Z Fold4 Graygreen , Használt karcmentes, Garancia 2026. 03. 22-ig
- darkFlash Shadow Pro
- ÁRGARANCIA! Épített KomPhone Ryzen 5 5600X 16/32/64GB RAM RTX 5050 8GB GAMER PC termékbeszámítással
- MÉG TOVÁBBI ÁRCSÖKKENTÉS MacBook Pro 17" i7 2.6 GHz 8GB RAM 8 ciklus az akkuban!
- BESZÁMÍTÁS! Apple MacBook Pro 16 M1 Max 64GB RAM 8TB SSD notebook garanciával hibátlan működéssel
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Ha kevesebb dolgom lesz, megpróbálom azt a formát kihozni.
Fferi50
