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

一般来说，我对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

Sub-all工作簿（）
从“文件夹选择器”对话框收集的Dim MyFolder As String路径
Dim MyFile作为字符串的文件名，由DIR函数获取
“将wbk设置为工作簿”用于循环每个工作簿
出错时继续下一步
Application.ScreenUpdating=False
'打开文件夹选择器对话框以允许用户选择
使用Application.FileDialog（msoFileDialogFolderPicker）
.Title=“请选择一个文件夹”
显示
.AllowMultiSelect=False
如果.SelectedItems.Count=0，则“如果未选择文件夹，则中止”
MsgBox“您没有选择文件夹”
出口接头
如果结束
MyFolder=.SelectedItems（1）&“\”将所选文件夹分配给MyFolder
以
MyFile=Dir（MyFolder）'Dir获取文件夹的第一个文件
'循环浏览文件夹中的所有文件，直到目录无法再找到为止
当我的文件“”时执行此操作
'打开文件并分配给wbk变量以供将来使用
设置wbk=Workbooks.Open（文件名：=MyFolder&MyFile）
'将下面的行替换为希望宏执行的语句
呼叫过滤器
呼叫重排
wbk.Close savechanges:=True
MyFile=Dir'Dir获取文件夹中的下一个文件
环
Application.ScreenUpdating=True
端接头
子过滤器（）
使用ActiveSheet.UsedRange
.Columns.AutoFit
.Rows.AutoFit
以
如果不是ActiveSheet.AutoFilterMode，则
ActiveSheet.Range（“A1”）.AutoFilter
如果结束
端接头
子重排（）
'
'重新排列宏
'将第一列中各个单元格中的所有数据拆分为各个列。
'
'键盘快捷键：Ctrl+Shift+R
'
行（“2:2”）。选择
选择。删除移位：=xlUp
行（“1:1”）。选择
范围（选择，选择。结束（xlDown））。选择
范围（选择，选择。结束（xlDown））。选择
列（“A:A”）。选择
Selection.TextToColumns Destination:=范围（“A1”），数据类型：=xlDelimited_
TextQualifier:=xlDoubleQuote，continuedDelimiter:=False，Tab:=True_
分号：=真，逗号：=假，空格：=假，其他：=假，字段信息_
：=数组（数组（1，1），数组（2，1），数组（3，1），数组（4，1），数组（5，1），数组（6，1）_
数组（7,1），数组（8,1），数组（9,1），数组（10,1），数组（11,1），数组（12,1），数组（13,1_
)，数组（14,1），数组（15,1），数组（16,1），数组（17,1），数组（18,1），数组（19,1），数组_
（20,1）、阵列（21,1）、阵列（22,1）、阵列（23,1）、阵列（24,1）、阵列（25,1）、阵列（26,1）_
数组（27,1）、数组（28,1）、数组（29,1）、数组（30,1）），TrailingMinusNumbers:=True
列（“A:A”）。选择
范围（选择，选择。结束（xlDown））。选择
范围（选择，选择。结束（xlToRight））。选择
范围（选择，选择。结束（xlToRight））。选择
范围（选择，选择。结束（xlDown））。选择
范围（选择，选择。结束（xlDown））。选择
行（“1:1”）。选择
范围（“G1”）。激活
Selection.Borders（xlDiagonalDown）.LineStyle=xlNone
Selection.Borders（xlDiagonalUp）.LineStyle=xlNone
Selection.Borders（xlEdgeLeft）.LineStyle=xlNone
Selection.Borders（xlEdgeTop）.LineStyle=xlNone
带Selection.Borders（底部）
.LineStyle=xlContinuous
.ColorIndex=0
.TintAndShade=0
.重量=xl中等
以
Selection.Borders（xlEdgeRight）.LineStyle=xlNone
Selection.Borders（xlInsideVertical）.LineStyle=xlNone
Selection.Borders（xlInsideHorizontal）.LineStyle=xlNone
范围（“G1”）。选择
范围（选择，选择。结束（xlToRight））。选择
自动筛选
ActiveSheet.Range（“$G$1:$AC$8000”）。自动筛选字段：=1
范围（“G1”）。选择
端接头

---

问题是，我一生都不能让第一行应用过滤器，也不能让列自动调整。这里有什么建议吗？

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

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

---

只需使用内置的。如果您需要一些VBA代码，请首先使用宏记录器，并根据您的需要改进该代码。如果遇到问题或错误，请返回代码并向其提问。这取决于第一个单元格中的数据格式。它是由分隔符分隔的还是有固定的长度？如果您的问题中包含一些样本，这会有所帮助。@z32a7ul显然用分号分隔：“请注意，所有不同的数据都用分号分隔。”@Pᴇʜ，我有成千上万的excel表格要过滤，这将花费我一辈子的时间