-
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
-
válasz
butch3r
#30300
üzenetére
Public Sub ttt()
Dim r1 As Range
Set r1 = Application.Intersect(Workbooks("Book1").Sheets("Sheet1").Range("B25:D65535"), Workbooks("Book1").Sheets("Sheet1").UsedRange)
Dim v1
v1 = r1.Value2
Dim r2 As Range
Set r2 = Application.Intersect(Workbooks("Book2").Sheets("Sheet1").Range("B25:D65535"), Workbooks("Book2").Sheets("Sheet1").UsedRange)
Dim v2
v2 = r2.Value2
Dim oldbound, newbound
oldbound = UBound(v1, 1)
newbound = oldbound + UBound(v2, 1)
Dim v_cel()
ReDim Preserve v_cel(1 To newbound, 1 To 3)
Dim ix, iy
For ix = 1 To UBound(v1, 1)
For iy = 1 To 3
v_cel(ix, iy) = v1(ix, iy)
Next
Next
For ix = 1 To UBound(v2, 1)
For iy = 1 To 3
v_cel(oldbound + ix, iy) = v2(ix, iy)
Next
Next
Dim r_cel As Range
Dim kezdosor
kezdosor = 10
Set r_cel = Workbooks("Book1").Sheets("Sheet2").Range("B" & kezdosor & ":D" & kezdosor + UBound(v1, 1) - 1)
r_cel.Value2 = v1
End Sub -
Grodd
tag
válasz
butch3r
#30300
üzenetére
Szia, ez nem olyan kompex, mint ahogy gondolod, valójában egy igen szimpla lekérdezés, pár egérkattintás az egész

Többféleképpen meg lehet oldani, de a makró az az eszköz, ami nekem utoljára eszembe jutna)
Más eszközökkel sokkal egyszerűbb.
A két leginkább alkalmas a Microsoft Query vagy a PowerQuery.Utóbbi kulturáltabb, de vagy Excel 2016 kell hozzá, vagy Office 365, vagy Excel 2010-2013 mellé PowerQuery add-in (ingyenesen tölrthető a Microsoft oldaláról)
Microsoft Query-ben egy pár egérkattintással több, és ha teljesen rugalmasra és automatizáltra akarod csinálni, akkor igényelni fog egy VBA sort is (PQuery-hez annyi sem kell).Persze megondható makróban is, nem nagy kunszt, ha feltétlenül ahhoz ragaszkodsz hozzá, de miért akarjunk fúróval szöget verni ?

Oszdd meg valahol a filet, és megcsinálom mindkét módon.
Új hozzászólás Aktív témák
- Samsung Galaxy S22 128GB,Átlagos,Adatkabel,12 hónap garanciával
- Apple iPhone 11 128 GB Fekete 1 év Garancia Beszámítás Házhozszállítás
- Nagyakkus! Dell Latitude 5430 i7-1255U 16GB 512GB 14" FHD 1 év garancia
- GYÖNYÖRŰ iPhone 14 Pro Max 128GB Purple -1 ÉV GARANCIA - Kártyafüggetlen, MS3913, 100% Akkumulátor
- Csere-Beszámítás! Playstation 5 Slim Digital edition konzol.
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: Promenade Publishing House Kft.
Város: Budapest

Fferi50
