1

更新的代码和问题（东部时间 2018 年 5 月 9 日下午 1:53）

我在尝试使用两个不同的分隔符将多个数据文本文件导入固定工作表（“原始数据”）时遇到问题。我正在使用 Application.GetOpenFilename 来允许用户从一个文件夹中选择多个文本文件。这些文件包含一个以分号分隔的标题行，然后是几行以逗号分隔的数据。在单个文本文件中，这种格式可以重复多次（这是一个检查日志文件，它为每次检查运行记录并附加数据到同一个文本文件，即标题行 1，一些数据行，标题行 2，更多行数据、标题第 3 行、更多数据行等）

根据我在 StackOverflow.com 上找到的其他示例，我尝试了几种方法来解决这个问题，但我似乎无法成功地将这些解决方案组合在一起以提出一个解决方案，该解决方案可以导入具有两个不同的单个或多个文本文件每个文件中的分隔符。我无法更改原始文本文件的格式或内容，因此无法搜索不同的分隔符并将其替换为单个分隔符。

以下是我在使用附加的 VBA 代码时遇到的剩余问题：

导入多个文本文件时，会在文件之间插入一个空白行，从而中断 .TextToColumns 部分。它还要求在导入选定的第二个文件时替换现有数据。有没有更有效或更好的方法来使用逗号和分号作为分隔符从多个文本文件中导入数据？

在本地硬盘的固定路径中，每个新订单号都会创建一个新的子文件夹来存储 .txt 数据文件（即 C:\AOI_DATA64\SPC_DataLog\IspnDetails\123456-7）。有没有办法可以提示用户输入子文件夹名称 (123456-7) 并且 VBA 脚本会自动从该子文件夹导入所有 .txt 文件，而不是使用 Application.GetOpenFilename？

这是我尝试导入的数据文件之一的截断版本。实际文件在数据行之间没有空格。我在此示例中将它们分开以清楚地显示文本文件中的每一行。

[StartIspn];Time=04/19/18 12:43:15;User=yeseniar;MachineID=WINDOWS-TEFJCS1;Side=T;DoubleSided;IsOnline=1;IA_Idx=1;SN_Idx=0;IT=0;SPC_Db=1;SPC_Txt=1;TxtFmt=10;E_Rpt=1;D_Img=1;FeedMode=0;

KC17390053F,VIA5F,M North,A8,85.0,45.0,96.0,23.2,9.9,0.0,0.0,0.0,59.0,0.0,0.0,0.0,

KC17390053F,VIA3F,M North,A8,85.0,45.0,96.0,22.3,22.9,0.0,0.0,0.0,59.0,0.0,0.0,0.0,

KC17390053F,FMI1F,S South,A13,12.3,0.0,1.0,3.5,3.5,0.0,0.0,0.0,0.0,0.0,0.0,0.0,

KC17390053F,FMI13F,S South,A13,12.3,0.0,1.0,3.5,3.5,0.0,0.0,0.0,0.0,0.0,0.0,0.0,

[StartIspn];Time=04/19/18 14:28:10;User=yeseniar;MachineID=WINDOWS-TEFJCS1;Side=B;DoubleSided;IsOnline=1;IA_Idx=1;SN_Idx=0;IT=0;SPC_Db=1;SPC_Txt=1;TxtFmt=10;E_Rpt=1;D_Img=1;FeedMode=0;

KC17390066B,VIA5B,M North,A8,70.0,50.0,92.0,-38.8,-3.7,0.0,0.0,0.0,50.0,0.0,0.0,0.0,

KC17390066B,VIA6B,M North,A8,70.0,50.0,93.0,-37.7,-23.6,0.0,0.0,0.0,50.0,0.0,0.0,0.0,

KC17390066B,FMI12B,S South,A13,4140.4,0.0,2.0,3.5,129.6,0.0,0.0,0.0,0.0,0.0,0.0,0.0,

KC17390066B,FMI24B,S South,A13,2128.7,0.0,2.0,3.5,119.1,0.0,0.0,0.0,0.0,0.0,0.0,0.0,

这是我到目前为止导入多个文本文件的内容：

Sub Import_DataFile()

' Add an error handler
On Error GoTo ErrorHandler

' Speed up this sub-routine by turning off screen updating and auto calculating until the end of the sub-routine
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

' Define variable names and types
Dim OpenFileName As Variant
Dim i As Long
Dim n1 As Long
Dim n2 As Long
Dim fn As Integer
Dim RawData As String
Dim rngTarget As Range
Dim rngFileList As Range
Dim TargetRow As Long
Dim FileListRow As Long
Dim dLastRow As Long
Dim destCell As Range

' Select the source folder and point list file(s) to import into worksheet
OpenFileName = Application.GetOpenFilename( _
               FileFilter:="AOI Inspection Results Data Files (*.txt), *.txt", _
               Title:="Select a data file or files to import", _
               MultiSelect:=True)

' Import user selected file(s) to "Raw Data" worksheet
TargetRow = 0
Set destCell = Worksheets("Raw Data").Range("B1")
For n2 = LBound(OpenFileName) To UBound(OpenFileName)
    fn = FreeFile
    Open OpenFileName(n2) For Input As #fn
    Application.StatusBar = "Processing ... " & OpenFileName(n2)

    Do While Not EOF(fn)
        Line Input #fn, RawData
        TargetRow = TargetRow + 1
        Worksheets("Raw Data").Range("B" & TargetRow).Formula = RawData

    Loop

    Next n2

    Close #fn

 Set rngTarget = Worksheets("Raw Data").Range("B1" & ":" & Worksheets("Raw Data").Range("B1").End(xlDown).Address)

   With rngTarget

    .TextToColumns Destination:=destCell, DataType:=xlDelimited, _
     TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
     Semicolon:=True, Comma:=True, Space:=False, Other:=False, OtherChar:="|", _
     FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

    End With

    Else: MsgBox "The selected file is not the correct format for importing data."

    Exit Sub

    End If

Next

' Create a number list (autofill) in Col A to maintain original import sort order
dLastRow = Worksheets("Raw Data").Cells(Rows.Count, "B").End(xlUp).Row
Worksheets("Raw Data").Range("A1:A" & dLastRow).Font.Color = RGB(200, 200, 200)
Worksheets("Raw Data").Range("A1") = "1"
Worksheets("Raw Data").Range("A2") = "2"
Worksheets("Raw Data").Range("A1:A2").AutoFill Destination:=Worksheets("Raw Data").Range("A1:A" & dLastRow), Type:=xlFillDefault
Worksheets("Raw Data").Range("F1:Q" & dLastRow).NumberFormat = "0.0"

' Auto fit the width of columns for RAW Data
Worksheets("Raw Data").Columns("A:Z").EntireColumn.AutoFit

' Turn screen updating and auto calculating back on since file processing is now complete
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

' Reset to defaults in the event of a processing error during the sub-routine execution
ErrorHandler:
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
If Err.Number <> 0 Then

' Display a message to the user including the error code in the event of an error during execution
MsgBox "An error number " & Err.Number & " was encountered!" & vbNewLine & _
       "Part or all of this VBA script was not completed.", vbInformation, "Error Message"
End If

End Sub
4

1 回答 1

2

很多问题......让我给一些提示。

  1. 提示用户输入工作目录：

    Dim fDlg As FileDialog      ' dialog box object
Dim sDir As String          ' selected path
Dim iretval As Long         ' test

Set fDlg = Application.FileDialog(msoFileDialogFolderPicker)
sDir = conDEFAULTPATH   ' init
With fDlg
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = sDir
    iretval = .Show
    If iretval = -1 Then sDir = .SelectedItems(1)
End With
Set fDlg = Nothing              ' drop object

If sDir = vbNullString Then
     MsgBox "Invalid directory"
Else
     If Right$(Trim$(sDir), 1) <> Application.PathSeparator Then _
          sDir = Trim$(sDir) & Application.PathSeparator' append closing backslash to pathname
End If

  2. 将文件收集到缓冲区

    Dim FileBuf(100) as string, FileCnt as long
FileCnt=0
FileBuf(FileCnt)=Dir(sDir & "*.txt")
Do While FileBuf(FileCnt) <> vbnullstring
       FileCnt = FileCnt + 1
       FileBUf(FileCnt) = Dir
Loop

  3. 减少分隔符的数量：只需使用替换

    RawData = Replace(RawData, ";", ",")

  4. 对于空行我不知道，尽管它可能是源文件中空行的结果，也许是 EOF。那么，如果您在复制之前检查该行怎么办：

    If len(trim(RawData)) > 0 Then 
    TargetRow = TargetRow + 1
    Worksheets("Raw Data").Range("B" & TargetRow) = RawData
End If

请注意，我已删除.Formula. 您正在处理价值观。

  1. 设置目标范围：您应该省略.Address. 要选择范围中的最后一个单元格，您应该使用.End(xlUp)这种方式：

    Set rngTarget = Worksheets("Raw Data").Range("B1" & ":" & Worksheets("Raw Data").Range("B1").End(xlUp))

我更喜欢使用直接单元格引用，所以 - 正如您确切知道最后一行 - 我会这样做：

Set rngTarget =  Worksheets("Raw Data").Range(Cells(1, 2), Cells(TargetRow, 2))

祝你好运！

于 2018-05-11T09:30:05.937 回答