-
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
-
Pakliman
tag
Szia!
Public Sub xx()
Const sFN As String = "d:\teszt.csv"
Dim csv As Integer
Dim sLine As String
Dim o As Long 'Az adatoszlopok száma...
Dim i As Long
Dim j As Long
Dim db As Long
Dim s As String
Dim arr0, arr
csv = FreeFile()
Open sFN For Input As csv
ReDim arr0(1 To 3, 0 To db)
Do While Not EOF(csv)
Line Input #csv, sLine
arr = Split(sLine, ";")
i = UBound(arr) + 1
If db = 0 Then o = i
If i = 3 Then
'Ha 3 részes a sor...
db = db + 1
ReDim Preserve arr0(1 To o, 0 To db)
s = arr(0)
'Töröljük az elejéről és/vagy a végéről a macskakörmöt
If Left(s, 1) = Chr(34) Then s = Mid(s, 2)
If Right(s, 1) = Chr(34) Then s = Left(s, Len(s) - 1)
arr0(1, db) = s
s = arr(1)
If Left(s, 1) = Chr(34) Then s = Mid(s, 2)
If Right(s, 1) = Chr(34) Then s = Left(s, Len(s) - 1)
arr0(2, db) = s
s = arr(2)
If Left(s, 1) = Chr(34) Then s = Mid(s, 2)
If Right(s, 1) = Chr(34) Then s = Left(s, Len(s) - 1)
arr0(3, db) = s
Else
'...ha nem, akkor az előző végéhez írjuk.
s = sLine
If Left(s, 1) = Chr(34) Then s = Mid(s, 2)
If Right(s, 1) = Chr(34) Then s = Left(s, Len(s) - 1)
arr0(3, db) = arr0(3, db) & vbCrLf & s
End If
Loop
Close #csv
For i = 1 To db
For j = 1 To o
Cells(i, j) = arr0(j, i)
Next j
Next i
End Sub
Új hozzászólás Aktív témák
- Linux Mint
- Debrecen és környéke adok-veszek-beszélgetek
- Azonnali notebookos kérdések órája
- Audi, Cupra, Seat, Skoda, Volkswagen topik
- Vezeték nélküli fülhallgatók
- Új Xeonokkal szorongatná meg az Intel az AMD-t
- Milyen okostelefont vegyek?
- Ubiquiti hálózati eszközök
- MW2 - MW3 játékosok baráti köre
- Samsung Galaxy S23 Ultra - non plus ultra
- További aktív témák...
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Lenovo L14 Ryzen 5 4500U Refurbished - Garancia!
- Apple iPhone SE 2020 128 GB Piros 1 év Garancia Beszámítás Házhozszállítás
- GYÖNYÖRŰ iPhone 14 128GB Midnight -1 ÉV GARANCIA - Kártyafüggetlen, MS3972
- BESZÁMÍTÁS! Intel Core i7 6700K 4 mag 8 szál processzor garanciával hibátlan működéssel
- Új könyv: Harrari: Sapiens Rajzolt történelem
Állásajánlatok
Cég: Central PC számítógép és laptop szerviz - Pécs
Város: Pécs
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50
