Hirdetés
- Luck Dragon: Asszociációs játék. :)
- btz: Internet fejlesztés országosan!
- Mr.Csizmás: Bestbuy travel, utazós, kirándulós topic - szállások, jegyek
- sziku69: Fűzzük össze a szavakat :)
- Ndruu: Segíts kereshetővé tenni a PH-s arcképeket!
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Doky586: SecureBoot kulcsok frissítése (2026 nyara)
- potyautas: Olyan valóságosnak tűnt
- ricsi99: 6. Genes alaplap tündöklése kontra MS/Zintel korlátozásai
- Hieronymus: Az igaz barátság kezdete
-
LOGOUT
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
CHANNIS
#14930
üzenetére
Átalakítottam.
Sub alma()
Dim sor%, tol%, ig%, usor%, nev$
Dim WS1 As Worksheet, WS2 As Worksheet
Set WS1 = Worksheets("Munka1")
Set WS2 = Worksheets("Munka2")
usor% = WS2.Range("I" & Rows.Count).End(xlUp).Row
For sor% = 3 To usor%
nev$ = WS2.Range("I" & sor%)
ig% = Application.WorksheetFunction.Match(nev$, WS1.Columns(2), 0)
tol% = ig%
Do While WS1.Cells(ig%, 2) = nev$
ig% = ig% + 1
Loop
WS1.Rows(ig%).EntireRow.Insert
WS1.Cells(ig%, "B") = WS2.Cells(sor%, "I")
WS1.Cells(ig%, "C") = WS2.Cells(sor%, "G")
WS1.Cells(ig%, "E") = WS2.Cells(sor%, "J")
WS1.Cells(ig%, "G") = WS2.Cells(sor%, "K")
WS1.Rows(ig% + 1).EntireRow.Insert
WS1.Rows(ig% + 2).EntireRow.Insert
Next
End Sub -
Delila_1
veterán
válasz
CHANNIS
#14900
üzenetére
Tedd ki a füzetet egy elérhető helyre. Nincs időm újra beirkálni az adataidat egy másik helyre. Ha azonnal az igazi helyükkel teszed fel a kérdést, már kész lenne. A makrót az előzően betett képeken szereplő oszlopokhoz írtam meg. Nem értem, miért más helyekre kérdeztél rá, nem a valósra.

-
Delila_1
veterán
válasz
CHANNIS
#14882
üzenetére
Küldöm az ígért makrót. A lista1 nálam az első lapon van, a lista2 pedig a másodikon.
Ezt adom meg a két 'Set =' kezdetű sorban.Sub alma()
Dim sor%, tol%, ig%, usor%, nev$, aktual%
Dim WS1 As Worksheet, WS2 As Worksheet
Set WS1 = Worksheets(1)
Set WS2 = Worksheets(2)
usor% = WS2.Range("J" & Rows.Count).End(xlUp).Row
For sor% = 3 To usor%
nev$ = WS2.Range("J" & sor%)
aktual% = Application.WorksheetFunction.Match(nev$, WS1.Columns(2), 0)
tol% = aktual%
Do While WS1.Cells(aktual%, 2) = nev$
aktual% = aktual% + 1
Loop
ig% = aktual% - 1
WS1.Rows(ig% + 1).EntireRow.Insert
WS1.Cells(ig% + 1, 1) = WS1.Cells(ig%, 1)
WS1.Cells(ig% + 1, 2) = WS1.Cells(ig%, 2)
WS1.Cells(ig% + 1, 4) = WS2.Cells(sor%, "K")
WS1.Rows(ig% + 2).EntireRow.Insert
WS1.Rows(ig% + 3).EntireRow.Insert
WS1.Cells(tol%, 4) = "=SUM(D" & tol% + 1 & ":D" & ig% + 3 & ")"
Next
End Sub
Új hozzászólás Aktív témák
Hirdetés
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Game Pass Ultimate előfizetések 3 - 36 hónapig azonnali kézbesítéssel! 13 hónap ultimate - 50.000 ft
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Eladó jogtiszta, Windows 11/10, Office 2019/2021/2024, Fizikai és Digitális licencek, Számlával.
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- GYÖNYÖRŰ iPhone 14 Pro 128GB Deep Purple -1 ÉV GARANCIA - Kártyafüggetlen, MS4574
- Lenovo X13 Gen 1 Ryzen 5 pro 4650U, 16GB RAM, SSD, jó akku, számla, garancia
- AKCIÓ! Gigabyte Z790 i7 14700KF 64GB DDR5 1TB SSD RTX 5070Ti 16GB LIAN LI LANCOOL 207 850W
- Új AKRACING CORE EX gamer szék dobozában, BONTATLAN!
- BESZÁMÍTÁS! Asus Z390 i7 9700 32GB DDR4 512GB SSD RTX 2070 Super 8GB Phanteks Eclipse P360A 650W
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest


Fferi50