-
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
-
bteebi
veterán
Sziasztok!
Van egy file-om egy modulban lévő makróval. A file különböző - de megegyező struktúrájú - lapjaira szeretnék más Excel file-okból adatokat bemásolni. A másolandó adatokon minimális változtatást végeznék: az eredeti adatok általános formátuma pl. "3.2k", ezt - az utolsó karakter levágása után - felszorzom 1000-rel, és azt szeretném bemásolni, a számformátumot "0"-ra állítva.
Összességében egy dialógusablakkal szeretném megnyitni az adatforrásként szolgáló file-t, viszont nem tudom, hogy hogyan kell(ene) meghivatkozni ahhoz, hogy menjen a másolás.
A jelenlegi makró:
Sub kitoltes()
Dim ablak As FileDialog, fajlnev As String, FileChosen As Integer
Set ablak = Application.FileDialog(msoFileDialogOpen)
FileChosen = ablak.Show
ablak.Title = "Válaszd ki az importálandó file-t"
ablak.InitialFileName = ActiveWorkbook.Path
ablak.InitialView = msoFileDialogViewList
ablak.Filters.Clear
ablak.Filters.Add "Excel 2003 worksheet", "*.xls"
ablak.Filters.Add "Excel 2010 worksheet", "*.xlsx"
ablak.Filters.Add "Excel makró", "*.xlsm"
ablak.FilterIndex = 1
If FileChosen = -1 Then
fajlnev = ablak.SelectedItems(1)
Workbooks.Open (fajlnev)
Else: Exit Sub
End If
Dim adat As Integer, oszlop As Integer
For adat = 1 To 10
For oszlop = 2 To 10 Step 4
'ebben a sorban valószínűleg több hiba is van:
ActiveSheet.Cells(19 + 2 * adat, oszlop) = 1000 * (Left(fajlnev.Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16), Len(fajlnev.Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16) - 1)))
ActiveSheet.Cells(19 + 2 * adat, oszlop).NumberFormat = "0"
Next oszlop
Next adat
End SubHa benne van az 1000-rel való szorzás, akkor "Type mismatch" hibát dob, ezért jobb híján beszúrtam egy plusz sort, így már legalább az a része működik:
ActiveSheet.Cells(19 + 2 * adat, oszlop) = ActiveSheet.Cells(19 + 2 * adat, oszlop) * 1000Tudnátok segíteni a hibák kijavításában? Előre is köszönöm!

Új hozzászólás Aktív témák
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- PC Game Pass előfizeté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 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Microsoft: Windows / Office / Server / Stb.
- Corsair SF1000 ÚJ // Számla // Garancia //
- Bomba ár! Lenovo ThinkPad T480s - i5-8GEN I 8GB I 256SSD I 14" FHD Touch I HDMI I Cam I W11 I Gari!
- Surface Pro 7+ i5-1135G7 16GB 512GB 1 év garancia
- GYÖNYÖRŰ iPhone 14 Pro Max 256GB Space Black -1 ÉV GARANCIA -Kártyafüggetlen, MS4031
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: Central PC számítógép és laptop szerviz - Pécs
Város: Pécs

Fferi50
