Excel 中文本文件的自动导入/绘图

Question

我运行一台机器，它可以输出多个要绘制的文本文件，我有一个 VBA 脚本，它可以从文件夹中导入我想要绘制的所有文件并将它们放在自己的工作表上。我想知道是否有一种方法可以在导入它们时自动绘制它们？我需要为每对测试提供一个单独的图表。那就是我有“测试A-1”和“测试A-2”，它们是相互绘制的，“测试B-1”和“测试B-2”在一个新的图表上等等。对不起，如果这令人困惑，我我对 VBA 还是很陌生，并且会喜欢这样的工具来让我的生活更轻松一些。我已经包含了我的代码，它完成了下面的所有导入。然后，每个文本文件（只是 x-y 散点图的数据）都有自己的表格，数据在 A 和 B 列中。提前为糟糕的格式道歉，我没有写！

Sub ImportTextToExcel()
'UpdatebyExtendoffice20180911
Dim xWb As Workbook
Dim xToBook As Workbook
Dim xStrPath As String
Dim xFileDialog As FileDialog
Dim xFile As String
Dim xFiles As New Collection
Dim I As Long
Dim xIntRow As Long
Dim xFNum, xFArr As Long
Dim xStrValue As String
Dim xRg As Range
Dim xArr

Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a folder"
If xFileDialog.Show = -1 Then
xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
If xFile = "" Then
MsgBox "No files found", vbInformation
Exit Sub
End If
Do While xFile <> ""
xFiles.Add xFile, xFile
xFile = Dir()
Loop
Set xToBook = ThisWorkbook
On Error Resume Next
Application.ScreenUpdating = False
If xFiles.Count > 0 Then

For I = 1 To xFiles.Count
Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Close False
xIntRow = ActiveCell.CurrentRegion.Rows.Count
For xFNum = 1 To xIntRow
Set xRg = ActiveSheet.Range("A" & xFNum)
xArr = Split(xRg.Text, " ")
If UBound(xArr) > 0 Then
For xFArr = 0 To UBound(xArr)
If xArr(xFArr) <> "" Then
xRg.Value = xArr(xFArr)
Set xRg = xRg.Offset(ColumnOffset:=1)
End If
Next
End If
Next
Next
End If
Application.ScreenUpdating = True
End Sub

Answer 1

Option Explicit

Sub ImportTextToExcel()
    'UpdatebyExtendoffice20180911
    Dim xWb As Workbook, xToBook As Workbook, ws As Worksheet
    Dim xFile As String, xStrPath As String, xStrValue As String
    Dim xRg As Range, cht As Chart
    Dim xFiles As New Collection
    Dim i As Long
    
    ' choose folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "Select a folder"
       If .Show = -1 Then
           xStrPath = .SelectedItems(1)
       End If
    End With
    If xStrPath = "" Then
        Exit Sub
    ElseIf Right(xStrPath, 1) <> "\" Then
        xStrPath = xStrPath & "\"
    End If

    ' build collection of text files
    xFile = Dir(xStrPath & "*.txt")
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    If xFiles.Count = 0 Then
        MsgBox "No files found", vbCritical
        Exit Sub
    End If

    ' import data
    Set xToBook = ThisWorkbook
    Application.ScreenUpdating = False
    For i = 1 To xFiles.Count
        
        ' import data into new sheet
        Set xWb = Workbooks.Open(xStrPath & xFiles.Item(i))
        xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
        Set ws = ActiveSheet
        ws.Name = xWb.Name
        xWb.Close False

        ' split on space
        Set xRg = ws.Range("A1")
        xRg.CurrentRegion.TextToColumns Destination:=xRg.Cells(1, 1), _
                          DataType:=xlDelimited, _
                          ConsecutiveDelimiter:=True, _
                          Space:=True, FieldInfo:=Array(Array(1, 1), Array(2, 1))
        
        ' create chart
        Set cht = ws.Shapes.AddChart.Chart
        With cht
            .ChartType = xlXYScatter
            .SetSourceData Source:=xRg.CurrentRegion
        End With
        
    Next
    Application.ScreenUpdating = True
    MsgBox xFiles.Count & " files imported", vbInformation
End Sub