Question

我对VBA完全陌生，但是我有CSV文件（所有文件的格式相同），并且我想将它们导入Excel上的单个工作表中。我能够根据以下代码读取CSV文件：

Sub R_AnalysisMerger()
Dim WSA As Worksheet
Dim bookList As Workbook
Dim SelectedFiles() As Variant
Dim NFile As Long
Dim FileName As String
Dim ws As Worksheet, vDB As Variant, rngT As Range

Application.ScreenUpdating = False

'Selects the CSV files as SELECTED FILES
Set ws = ThisWorkbook.Sheets(1)
ws.UsedRange.Clear  'Clears current worksheet
SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.csv*), *.csv*", MultiSelect:=True) 'Selects csv files


For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
    FileName = SelectedFiles(NFile)
    Set bookList = Workbooks.Open(FileName, Format:=2)
    Set WSA = bookList.Sheets(1)
    With WSA
        vDB = .UsedRange
        Set rngT = ws.Range("a" & Rows.count).End(xlUp)(2)
        If rngT.Row = 2 Then Set rngT = ws.Range("A1")
        rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB

        bookList.Close (0)
    End With
Next
Application.ScreenUpdating = True
ws.Range("A1").Select

但是我还有其他要求：跳过第一列。跳过前四行。从第五行的每个单词中删除某个字符串。

我习惯于使用Java，通常我会使用“ for”循环读取每一行，并设置“ if”语句以跳过第一行和四列，并从每个字符串中删除该字符串（如果存在的话）。

我不知道如何使用此代码执行此操作。据我了解，它只是将整个CSV文件复制到工作表中？

Answer 1

此解决方案基于读取CSV作为文本流。我尝试过包括使所有功能（例如选择列，行等）成为可能的功能。

Sub ImportCSV()    

Dim fso As New IWshRuntimeLibrary.FileSystemObject
Dim txtStream  As IWshRuntimeLibrary.TextStream
Dim files As IWshRuntimeLibrary.files
Dim file As IWshRuntimeLibrary.file
Dim txtLine As String
Dim lineCount As Integer
Dim lastRow As Integer
Dim lineCol As Variant
Dim rng As Range

Application.ScreenUpdating = False
ThisWorkbook.Sheets(1).usedRange.Delete
Set rng = ThisWorkbook.Sheets(1).usedRange
lastRow = 1
Set files = fso.GetFolder("path\folder").files

For Each file In files
    If file.Name Like "*.csv" Then
        Set txtStream = file.OpenAsTextStream(ForReading, TristateUseDefault)
        txtStream.SkipLine                                 ' skip first line, since it containes headers
        lineCount = 1
        Do
            txtLine = txtStream.ReadLine
            If lineCount = 5 Then
                txtLine = Replace(txtLine, "stringToReplace", "StringToReplcaeWith")    ' replace certain string from words in 5'th row
            End If
            lineCount = lineCount + 1
            lineCol = sliceStr(Split(txtLine, ";"), startIdx:=4)        ' slice the array so to skip four first columns
            For iCol = 0 To UBound(lineCol)                             ' write columns to last row
                rng(lastRow, iCol + 1).Value = lineCol(iCol)
            Next iCol
            lastRow = lastRow + 1
            'Debug.Print Join(lineCol, ";")                              ' debug
        Loop Until txtStream.AtEndOfStream
    End If
Next file
Application.ScreenUpdating = True
End Sub

这是切片器功能

Function sliceStr(arr As Variant, startIdx As Integer, Optional stopIdx As Integer = 0) As String()
        If stopIdx = 0 Then
           stopIdx = UBound(arr)
        End If
        Dim tempArrStr() As String
        ReDim tempArrStr(stopIdx - startIdx)
        Dim counter As Integer
        counter = 0
        For i = startIdx To stopIdx
            tempArrStr(counter) = arr(i)
            counter = counter + 1
        Next
        sliceStr = tempArrStr
End Function

Answer 2

我只是做了一个简单的测试，下面的代码似乎起作用了。试试吧，并提供反馈。

Sub Demo()
     Dim fso As Object 'FileSystemObject
     Dim fldStart As Object 'Folder
     Dim fld As Object 'Folder
     Dim fl As Object 'File
     Dim Mask As String

Application.ScreenUpdating = False
 Dim newWS As Worksheet

Set newWS = Sheets.Add(before:=Sheets(1))

    Set fso = CreateObject("scripting.FileSystemObject") ' late binding
     'Set fso = New FileSystemObject 'or use early binding (also replace Object types)

    Set fldStart = fso.GetFolder("C:\Users\ryans\OneDrive\Desktop\output\") ' <-- use your FileDialog code here
     Mask = "*.csv"
     'Debug.Print fldStart.Path & ""
     ListFiles fldStart, Mask
     For Each fld In fldStart.SubFolders
         ListFiles fld, Mask
         ListFolders fld, Mask
     Next

Dim myWB As Workbook, WB As Workbook
 Set myWB = ThisWorkbook
 Dim L As Long, t As Long, i As Long
 L = myWB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
 t = 1
 For i = 1 To L
 Workbooks.OpenText Filename:=myWB.Sheets(1).Cells(i, 1).Value, DataType:=xlDelimited, Tab:=True
 Set WB = ActiveWorkbook
 lrow = WB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
 WB.Sheets(1).Range("B4:E" & lrow).Copy newWS.Cells(t, 2)
 t = myWB.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row + 1
 WB.Close False
 Next
 myWB.Sheets(1).Columns(1).Delete
 Application.ScreenUpdating = True
 End Sub



Sub ListFolders(fldStart As Object, Mask As String)
     Dim fld As Object 'Folder
     For Each fld In fldStart.SubFolders
         'Debug.Print fld.Path & ""
         ListFiles fld, Mask
         ListFolders fld, Mask
     Next
 End Sub



Sub ListFiles(fld As Object, Mask As String)
 Dim t As Long
     Dim fl As Object 'File
     For Each fl In fld.Files
         If fl.Name Like Mask Then
         t = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
             'Debug.Print fld.Path & "" & fl.Name
             If Sheets(1).Cells(1, 1) = "" Then
             Sheets(1).Cells(1, 1) = fld.Path & "\" & fl.Name
             Else
             Sheets(1).Cells(t, 1) = fld.Path & "\" & fl.Name
             End If
         End If
     Next
 End Sub

VBA-将多个CSV导入到工作表，删除某些行/列

2 个答案: