Hirdetés
-
IT café
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
-
sztanozs
veterán
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 SubJOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...
Új hozzászólás Aktív témák
- Microsoft Office Home & Business 2024 PC/Mac EP2-06638
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - 1190 Ft-tól!
- NORTON 360 for Mobile! 1 eszköz, 1 év! DOBOZOS, BONTATLAN!
- AKCIÓ! Microsoft szoftverek, vírusírtó szoftverek, egyéb szoftverek széles választéka!
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest