-
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
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- HIBÁTLAN iPhone 14 Pro Max 512GB Silver -1 ÉV GARANCIA - Kártyafüggetlen
- Lenovo ThinkPad // T - Széria // X1 carbon // X1 Yoga 2-in-1 // és a többiek... 3-12. gen.
- Apple iPhone 15 / 128GB / Kártyafüggetlen / 12Hó Garancia / Akku:83%
- Huawei Free Clip 2 - Hüvely a füledre, de a füled a hüvelye
- CÉGEK FIGYELEM!! iPhone 11 64GB Black -1 ÉV GARANCIA - 27% ÁFA-S SZÁMLA Kártyafüggetlen, 100% Akksi
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest

Fferi50
