Hirdetés
- Milyen TV-t vegyek?
- HiFi műszaki szemmel - sztereó hangrendszerek
- Projektor topic
- Samsung LCD és LED TV-k
- Intel Core i3 / i5 / i7 8xxx "Coffee Lake" és i5 / i7 / i9 9xxx “Coffee Lake Refresh” (LGA1151)
- Vezetékes FEJhallgatók
- Milyen videókártyát?
- Melyik tápegységet vegyem?
- SSD kibeszélő
- Milyen belső merevlemezt vegyek?
-
PROHARDVER!
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
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Gyermek PC játékok
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- 131 - Lenovo Legion Pro 7 (16IRX9H) - Intel Core i9-14900HX, RTX 4080
- Apple iPhone 11 64GB,Átlagos,Adatkabel,12 hónap garanciával
- GYÖNYÖRŰ iPhone 13 mini 128GB Pink -1 ÉV GARANCIA - Kártyafüggetlen, MS3841, 100% Akkumulátor
- Windows 10 / 11 Pro Retail aktiváló kulcs Azonnal szállítással, számlával, garanciával!
- BESZÁMÍTÁS! GIGABYTE B760M i7 12700 32GB DDR4 512GB SSD RX 7800 XT 16GB LianLi Lancool 216 ARGB 750W
Állásajánlatok
Cég: Laptopszaki Kft.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Ha kevesebb dolgom lesz, megpróbálom azt a formát kihozni.
Fferi50

