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

将第一列中的文本分成几列

1 个答案: