Question

我有一个vba代码可以将多个txt文件导入excel。每个txt文件都包含以#开头的几行。这行我想跳过并在没有#的第一行开始导入。

我用来导入文件的代码如下：

Sub Import_Text_Files()
  Dim sPath As String
  Dim oPath, oFile, oFSO As Object
  Dim r, iRow As Long
  Dim wbImportFile As Workbook
  Dim wsDestination As Worksheet

  sPath = "C:\txt-files\"

  Set wsDestination = ThisWorkbook.Sheets("Daten")

  i = 1

  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oPath = oFSO.GetFolder(sPath)
  Application.ScreenUpdating = False

  For Each oFile In oPath.Files
    r = 4
    If LCase(Right(oFile.Name, 4)) = ".txt" Then
        Workbooks.OpenText fileName:=oFile.Path, Origin:=65001, StartRow:=1, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True

        Set wbImportFile = ActiveWorkbook
        For iRow = 1 To wbImportFile.Sheets(1).UsedRange.Rows.Count
            wbImportFile.Sheets(1).UsedRange.Rows(iRow).Copy wsDestination.Cells(r, i)
            r = r + 1
            End If
        Next iRow
        wbImportFile.Close False
        Set wbImportFile = Nothing
      End If
    i = i + 7

    Next oFile

  End Sub

我尝试使用INSTR，但它没有用。

有人能帮助我吗？

Answer 1

我找到了一个删除所有空单元格和以＃

开头的单元格的解决方案

Sub Read_Text_Files()

    Dim sPath As String
    Dim oPath, oFile, oFSO As Object
    Dim r, iRow As Long
    Dim wbImportFile As Workbook
    Dim wsDestination As Worksheet

    sPath = "C:\Daten\"

    Set wsDestination = ThisWorkbook.Sheets("Daten")

    i = 1
    j = 1

    Set oFSO = CreateObject("Scripting.FileSystemObject")

        Set oPath = oFSO.GetFolder(sPath)
        Application.ScreenUpdating = False

        For Each oFile In oPath.Files
        r = 4

            If LCase(Right(oFile.Name, 4)) = ".txt" Then

                Workbooks.OpenText fileName:=oFile.Path, Origin:=65001, StartRow:=1, DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, FieldInfo:=Array(1, 1), _
                TrailingMinusNumbers:=True

                Set wbImportFile = ActiveWorkbook
                For iRow = 1 To wbImportFile.Sheets(1).UsedRange.Rows.Count
                    wbImportFile.Sheets(1).UsedRange.Rows(iRow).Copy wsDestination.Cells(r, i)
                    r = r + 1
                Next iRow
                wbImportFile.Close False
                Set wbImportFile = Nothing
            End If
        i = i + 7
        j = j + 1

    Next oFile

    Dim rng As Range

    Set rng = ActiveCell

    For k = 1 To wsDestination.UsedRange.Columns.Count
        For l = 1 To 20
            wsDestination.Cells(4, k).Select

            If IsEmpty(wsDestination.Cells(4, k)) Then
                Cells(4, k).Delete xlShiftUp
            End If

            If InStr(wsDestination.Cells(4, k).Value, "#") = 0 Then
            Else
                Cells(4, k).Delete xlShiftUp
            End If
        Next l
    Next k

End Sub

vba导入文本文件忽略特殊行

1 个答案: