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

时间:2019-03-19 09:27:34

标签: vba split delimiter

已更新*

我是VBA的新手,希望能获得帮助

我有一个工作表,其中该结构的A列中包含该内容:

A1:列标题 A2:044000 randomwordx(数字和随机词之间有3个空格)
A3:056789 randomwordy(数字和随机词之间有3个空格) A4:

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

A8:600000 randomwordz(数字和随机词之间有3个空格)
A9:654124个随机词(数字和随机词之间有3个空格)

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

我想做的是以下事情:

转到A列-选择所有以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:randomwordx

D3:randomwordy

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

感谢您的帮助

1 个答案:

答案 0 :(得分:0)

这应该做您想要的。我使用Portland Runner's answer to this post在我的VBA中设置了RegEx引用并学习了其语法。我将计算A列的最后一行,并使用具有如此多次迭代的for循环,而不是for每个循环。将i变量设置为2,以跳过第1行中的标题。

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.