VBA 拆分单元格并仅粘贴特定单元格

Question

已更新*

我是 VBA 的新手，因此将不胜感激

我有一个 sheet，我在这个结构的 A 列中有一个内容：

A1：列标题 A2: 044000 randomwordx (number 和 randomwords 之间有 3 个空格)
A3: 056789 randomwordy (number 和 randomwords 之间有 3 个空格) A4:

A5: a.) 随机词
A6: 3.randomwords A7:

A8: 600000 randomwordz (number 和 randomwords 之间有 3 个空格)
A9: 654124个随机词（number和randomwords之间有3个空格）

A 列中数字和随机词之间的分隔符始终是 3 个空格

我想做的是：

转到 A 列 - select 所有以 6 位数开头的单元格

拆分这些单元格并将它们粘贴到 C 和 D 列
C 列应仅包含起始数字，删除所有前导零（例如，如果单元格 A2 具有 044000，则单元格 C2 应为 44000）
D 列应仅包含 A 列起始编号之后的文本（在此示例中，D2 应为 "randomwordx"
A 列中的空白单元格或不以 6 位数字开头的单元格不应粘贴到 C 和 D 列中（在此示例中，A4、A5、A6、A7 不应粘贴到C和D列）

所以它应该是这样的

C 列： C1：列标题

C2:44000

C3:56789

C4:60000

C5:653124

D 列：

D1：列标题

D2:随机词x

D3:随机单词

D4:randomwordz

D5:随机词

我只做到了这一点，所以将不胜感激

Option Explicit

Sub Splitcolumn() 
Dim mrg As Range
Dim LastRow As Long
Dim r As Range
Dim splitted() As String

With Sheets("test")
    Set mrg = Sheets("test").Range("A4:A" & LastRow)
    For Each r In mrg 
        splitted = Split(r.Value, "   ") 
        r.Value = splitted(0)
        r.Offset(2, 3).Value = splitted(1) & "   " & splitted(2)
    Next r
End With
End Sub

我收到运行时错误 1004

感谢您的帮助

Answer 1

这应该可以满足您的要求。我使用 Portland Runner's answer to this post 在我的 VBA 中设置了 RegEx 引用并学习了它的语法。我没有使用 for each 循环，而是计算 A 列的最后一行，并使用 for 循环进行多次迭代。 i 变量设置为 2 以跳过第 1 行中的 header。

Sub SplitCol()
    'Set references to active workbook and sheet
    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = ActiveWorkbook
    Set ws = wb.ActiveSheet

    'Create Regular Expression object and set up options
    Dim regEx As New RegExp
    With regEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        '[0-9] means that regex will check for all digits
        '{6} means that a minimum of 6 consecutive chars must meet the [0-9] criteria
        .pattern = "[0-9]{6}"
    End With

    'All .Methods and .Properties will belong to ws object due to With
    With ws
        'Determine how many rows to loop through
        Dim lastRowA As Long
        lastRowA = .Range("A" & .Rows.Count).End(xlUp).Row

        'Main loop
        Dim i As Integer
        For i = 2 To lastRowA
            'Make sure there is a value in the cell or code will error out
            If Cells(i, 1).Value <> "" Then
                'Test regex of cell
                If regEx.Test(Split(Cells(i, 1).Value, "   ")(0)) Then
                    'If regex was true, set 3rd column (C) equal to numbers and
                    '4th column (D) equal everything else
                    Cells(i, 3).Value = Split(Cells(i, 1).Value, "   ")(0)
                    Cells(i, 4).Value = Split(Cells(i, 1).Value, "   ")(1)
                End If
            End If
        Next
    End With

    'Release regEx object to reduce memory usage
    Set regEx = Nothing

End Sub

This is what the code should make the sheet look like.

VBA 拆分单元格并仅粘贴特定单元格

VBA Split Cells and paste only specific cells

vba

split

delimiter