Как загрузить секционированный файл CSV на лист Excel?

Question

CSV-файл:

#3GMACRO,,,,,,,,,,,,,,
,,,,,,,,,,,,,,
IMSI,IMEI,Date,Time,UMTS MACRO-UARFCNDL,UMTS MACRO-PrimaryScramblingCode,UMTS MACRO-CPICHTxPower,UMTS MACRO-PLMNCellId,UMTS MACRO- RNCId,UMTS MACRO-MCC,UMTS MACRO-MNC,UMTS MACRO - LAC,UMTS MACRO - RAC,UMTS MACRO - MaxUETxPower,UMTS MACRO - MeasuredRSCP
2.6275E+14,3.57539E+14,20100107,160000,10662,11,-99,268435456,0,0,0,1,0,0,-74

,,,,,,,,,,,,,,
#3GFEMTO,,,,,,,,,,,,,,
,,,,,,,,,,,,,,
IMSI,IMEI,Date,Time,UMTS FEMTOS-UARFCNDL,UMTS FEMTOS-PrimaryScramblingCode,UMTS FEMTOS-CPICHTxPower,UMTS FEMTOS-PLMNCellId,UMTS FEMTOS-RNCId,UMTS FEMTOS-MCC,UMTS FEMTOS-MNC,UMTS FEMTOS-LAC,UMTS FEMTOS-RAC,UMTS FEMTOS-MaxUETxPower,UMTS FEMTOS- MeasuredRSCP
2.6275E+14,3.57539E+14,20100107,160000,10687,252,-24,61,0,610,3956,486,11,5,-102

,,,,,,,,,,,,,,
#2GMACRO,,,,,,,,,,,,,,
,,,,,,,,,,,,,,
IMSI,IMEI,Date,Time,GSM MACRO_CellID,GSM MACRO-MCC,GSM MACRO-MNC,GSM MACRO-LAC,GSM MACRO-RAC,GSM MACRO-Max permitted UE Tx power (SIB3),GSM MACRO-Measure RSSI,,,,
2.6275E+14,3.57539E+14,20100107,160000,GSM_Cell_Id=1,2,3,4,5,6,7,,,,

Я хочу, чтобы этот CSV-файл загружался в лист Excel как отдельный раздел, когда я нажимал на кнопку «загрузить» только один раз (т.е. каждый раздел должен идти на отдельный лист Excel)

CSV-файл содержит название раздела, заголовок и данные

Ниже приведены названия разделов в файле CSv

3GMACRO

3GFEMTO

2GMACRO

Ниже приведены имена заголовков в файле CSv. IMSI, IMEI, дата, время, GSM MACRO_CellID, GSM MACRO-MCC, GSM MACRO-MNC ............ и т. Д.

3 листа должны иметь заголовки и данные после загрузки CSV-файла.

Пожалуйста, помогите мне в этом.

Заранее спасибо

привет это то, что я попробовал код, но он не работает идеально, как нужно.

Sub loadData()

'Runtime error handling
'On Error Resume Next

'Unprotect the password protected sheet for loading csv data
ActiveSheet.Unprotect Password:=pass

'Variable declaration
 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 (*.csv),*.csv", , "Please select text file...")
 'MsgBox "stringfullpath" & strFullPath


    If strFullPath = "False" Then Exit Sub  'User pressed Cancel on the open file dialog


    'This gives us a full path name e.g. C:tempfolderfile.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"

    oRS.Open "SELECT * FROM " & strFilename, oConn
    While Not oRS.EOF
        Sheets("Neighbour3GMacro").Range("A3").CopyFromRecordset oRS
        'Sheets.Add Type:=Application.GetOpenFilename & "     *.csv"
        Sheets("Neighbour3GFemto").Range("A2").CopyFromRecordset oRS
        Sheets("Neighbour2GMacro").Range("A2").CopyFromRecordset oRS

    Wend

    oRS.Close
    oConn.Close
End Sub

Answer 1

Вы можете использовать функцию Split для получения массива и использовать этот массив для заполнения строки.Вот простое решение.

Вам потребуется изменить Sheet1, Sheet2, Sheet3 на имена рабочих листов и, возможно, захотите добавить функциональность, чтобы игнорировать строки заголовка.Если у вас есть исправление ColumnCount, вы также можете заменить функцию Ubound на целочисленную переменную.

Sub loadData2()
Dim strFullPath As String
Dim oFSOBj As Object 'Scripting.FileSystemObject'
Dim oFileStream As Object 'Scripting.TextStream'

Dim targetSheet As Worksheet
Dim iRow As Long
Dim startRow As Long
Dim startColumn As Integer

Dim line As String

    'Please insert Error Handling etc.'

    'Get a text file name '
    strFullPath = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select text file...")
    If strFullPath = "False" Then Exit Sub  'User pressed Cancel on the open file dialog'

    Set oFSOBj = CreateObject("SCRIPTING.FILESYSTEMOBJECT")
    Set oFileStream = oFSOBj.GetFile(strFullPath).OpenAsTextStream(ForReading)

    Set targetSheet = Sheet1
    iRow = 0
    startRow = 3
    startColumn = 1

    While (Not oFileStream.AtEndOfStream)
        line = oFileStream.ReadLine
        If (Left(line, 1) = "#") Then
            iRow = 0
            If (Left(line, 8) = "#3GMACRO") Then Set targetSheet = Sheet1
            If (Left(line, 8) = "#3GFEMTO") Then Set targetSheet = Sheet2
            If (Left(line, 8) = "#2GMACRO") Then Set targetSheet = Sheet3
        ElseIf Trim(line) <> vbNullString Then  'Else Block: line has content'
            csline = Split(line, ",")
            targetSheet.Range(targetSheet.Cells(startRow + iRow, startColumn), targetSheet.Cells(startRow + iRow, startColumn + UBound(csline))).Value2 = csline
            iRow = iRow + 1
        End If
    Wend
    oFileStream.Close
    Set oFileStream = Nothing
    Set oFSOBj = Nothing
End Sub