将第一列中的文本拆分为几列

Question

总的来说，我对 VBA 不太熟悉，与我习惯的（主要是汇编语言）相比，Excel 编程有点让我失望。

基本上，我工厂的一台机器将它记录的所有数据放入 Excel 表中；它标记所有内容并记录每个数据，但它将所有数据保留在第一列中每个周期的单个单元格中，因此我每天都会归档大约 500 行。我正在尝试分析和分离每个单元格中的数据，以便我可以绘制它并希望证明我遇到的一些问题的解决方案。

任何帮助我创建某种程序我可以运行以将多个 Excel 工作表中的数据拆分到同一个 Excel 工作表但分成多个列，将不胜感激。请注意，所有不同的数据都用分号分隔。

---

所以我使用以下数据循环浏览给定文件夹中的所有 Excel 工作表。我从另一个开发者那里得到了这段代码：

Sub AllWorkbooks()
    Dim MyFolder As String 'Path collected from the folder picker dialog    
    Dim MyFile As String 'Filename obtained by DIR function   
    Dim wbk As Workbook 'Used to loop through each workbook

    On Error Resume Next

    Application.ScreenUpdating = False

    'Opens the folder picker dialog to allow user selection
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show    
        .AllowMultiSelect = False
        If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
            MsgBox "You did not select a folder"    
            Exit Sub
        End If

        MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
    End With

    MyFile = Dir(MyFolder) 'DIR gets the first file of the folder

    'Loop through all files in a folder until DIR cannot find anymore
    Do While MyFile <> ""    
        'Opens the file and assigns to the wbk variable for future use    
        Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)    
        'Replace the line below with the statements you would want your macro to perform    
        Call Filter    
        Call Rearrange    
        wbk.Close savechanges:=True    
        MyFile = Dir 'DIR gets the next file in the folder    
    Loop

    Application.ScreenUpdating = True 
End Sub



Sub Filter()
    With ActiveSheet.UsedRange
        .Columns.AutoFit
        .Rows.AutoFit
    End With

    If Not ActiveSheet.AutoFilterMode Then
        ActiveSheet.Range("A1").AutoFilter
    End If 
End Sub



Sub Rearrange()
    '
    ' Rearrange Macro
    ' Split all the data in the individual cells in the first column into individual columns.
    '
    ' Keyboard Shortcut: Ctrl+Shift+R
    '
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    Rows("1:1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1)), TrailingMinusNumbers:=True
    Columns("A:A").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select

    Rows("1:1").Select
    Range("G1").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("G1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter
    ActiveSheet.Range("$G$1:$AC$8000").AutoFilter Field:=1
    Range("G1").Select
End Sub

问题是，我无法在我的一生中获得应用过滤器的第一行，也无法获得 AutoFit 的列。这里有什么建议吗？

Answer 1

假设原始数据显然不包含任何分号（否则您应该处理它们的转义），显然不存在引号中的字符串之类的东西，其中分号不应被解释为分隔符，并且空字段显然没有被删除，试试下面的代码。下一次，请表现出一些尝试解决问题的努力。

Option Explicit

Public Sub SplitFirstCells()
    Dim ewsTarget As Worksheet: Set ewsTarget = ActiveSheet
    Dim r As Long: For r = 1 To ewsTarget.UsedRange.Rows.Count
        Dim strValue As String: strValue = CStr(ewsTarget.Cells(r, 1).Value)
        Dim varParts As Variant: varParts = Split(strValue, ";")
        Dim c As Long: For c = LBound(varParts) To UBound(varParts)
            ewsTarget.Cells(r, 1 + c - LBound(varParts) + 1).Value = varParts(c)
        Next c
    Next r
End Sub