- sziku69: Fűzzük össze a szavakat :)
- sziku69: Szólánc.
- Luck Dragon: Asszociációs játék. :)
- Brain turbó: Intel Xeon CPU asztali alaplapban
- Sub-ZeRo: Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- mefistofeles: Az elhízás nem akaratgyengeség!
- Geri Bátyó: Agglegénykonyha 13 – Néhány egyszerű, de finom étel
- aquark: KGST processzorok 1984-ig
- Parci: Milyen mosógépet vegyek?
- hcl: Eszelős szívatás : kijelzőtükrözés 2026
-
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
-
Kraptor
őstag
válasz
hbbalint
#101
üzenetére
Úgy simán sehogy, mert 65K a limit, de vannak okosságok amivel meglehet kerülni ezeket. Van egy progi amit Microsoft Office Spreadsheet 10.0 UserForm control-nak hívnak és ezzel elvileg létretudsz hozni 18,278 x 262,144-es lapokat.Ezt nem tudom, hogy mennyire igaz vagy nem.
Vagy vannak különböző makrók amikkel megtudsz nyitnyi nagyobb fileokat, csak akkor több lapba fogja megnyitni őket automatikusan.
Sub ImportLargeFile()
'Imports text file into Excel workbook using ADO.
'If the number of records exceeds 65536 then it splits it over more than one sheet.
Dim strFilePath As String, strFilename As String, strFullPath As String
Dim lngCounter As Long
Dim oConn As Object, oRS As Object, oFSObj As Object
'Get a text file name
strFullPath = Application.GetOpenFilename(''Text Files (*.txt),*.txt'', , ''Please select text file...'')
If strFullPath = ''False'' Then Exit Sub 'User pressed Cancel on the open file dialog
Application.ScreenUpdating = False
'This gives us a full path name e.g. C:\folder\file.txt
'We need to split this into path and file name
Set oFSObj = CreateObject(''SCRIPTING.FILESYSTEMOBJECT'')
strFilePath = oFSObj.GetFile(strFullPath).ParentFolder.Path
strFilename = oFSObj.GetFile(strFullPath).Name
'Open an ADO connection to the folder specified
Set oConn = CreateObject(''ADODB.CONNECTION'')
oConn.Open ''Provider=Microsoft.Jet.OLEDB.4.0;'' & _
''Data Source='' & strFilePath & '';'' & _
''Extended Properties=''''text;HDR=Yes;FMT=Delimited''''''
Set oRS = CreateObject(''ADODB.RECORDSET'')
'Now actually open the text file and import into Excel
oRS.Open ''SELECT * FROM '' & strFilename, oConn, 3, 1, 1
While Not oRS.EOF
Sheets.Add
ActiveSheet.Range(''A1'').CopyFromRecordset oRS, 65536
Wend
oRS.Close
oConn.Close
Application.ScreenUpdating = True
End Sub
Itt egy másik is:
Sub LoadData()
Const cCol1 = 20, cCol2 = 20, cCol3 = 20, cLimit = 50000
Dim intFreeFile As Integer, i As Long, j As Long, strTemp As String
Dim arr() As String
On Error Resume Next
intFreeFile = FreeFile
Open ''c:\test.txt'' For Input As #intFreeFile
i = 0: j = 1
ReDim arr(cLimit, 2)
Do Until EOF(intFreeFile)
Line Input #intFreeFile, strTemp
arr(i, 0) = Trim(Mid(strTemp, 1, cCol1))
arr(i, 1) = Trim(Mid(strTemp, cCol1, cCol2))
arr(i, 2) = Trim(Mid(strTemp, cCol1 + cCol2, cCol3))
i = i + 1
If i > cLimit - 1 Then
Cells(1, j).Resize(cLimit, 3).Value = arr
i = 0: j = j + 3
ReDim arr(cLimit, 2)
End If
Loop
Close #intFreeFile
End Sub
Új hozzászólás Aktív témák
- Anglia - élmények, tapasztalatok
- Arc Raiders
- NVIDIA GeForce RTX 5080 / 5090 (GB203 / 202)
- Mobil flották
- Intel Core i5 / i7 / i9 "Alder Lake-Raptor Lake/Refresh" (LGA1700)
- sziku69: Fűzzük össze a szavakat :)
- Apple MacBook
- Samsung Galaxy A56 - megbízható középszerűség
- Milyen asztali médialejátszót?
- sziku69: Szólánc.
- További aktív témák...
- Antivírus szoftverek, VPN
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Fallout 4 Pip-Boy Edition eladó
- Huawei P30 128GB, Kártyafüggetlen, 1 Év Garanciával
- 5G LTE! Microsoft Surface Pro 8 i7-1185G7 16GB 256GB 1 év garancia
- Samsung Galaxy A33 5G 128GB, Kártyafüggetlen, 1 Év Garanciával
- Új MSI 15 Cyborg FHD IPS 144Hz i7-13620H 10mag 16GB 512GB SSD Nvidia RTX 4060 8GB Win11 Garancia
- Cisco Catalyst C1000-48T-4G-L 48xRJ45 4xSFP switch, használt
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Fferi50
