将 B 列中的拆分数据粘贴到 D 列和 E 列中

Question

在 B 列中有 5 个字符的项目代码 + 项目描述。 我设法制作了一个宏，将 B 列中的 5 个字符项目代码复制/粘贴到 D 列中，并将项目描述复制/粘贴到 E 列中。

例子：

          Column B              Column C  Column D     Column E
XX787 DO BOLOGNESE 2X2.28KG FR   <other>    XX787    DO BOLOGNESE 2X2.28KG FR

我面临以下问题：

• 例如，大约 1% 的商品代码不是 5 个字符而是 8 个字符
• 8个字符中存在的这个百分比是数字，以0开头

如您所见，最后 2 个是具有不同格式的项目代码示例，即使数量很少，当然也必须考虑在内。

所以在我目前的编码中，会出现以下问题：

我认为宏应该执行以下操作以使其正常工作：

对于 D 列中的项目代码：复制/粘贴 B 列第一个空格之前的所有字符 对于 E 列中的项目描述：复制/粘贴第一个空格后的所有字符

我目前为此运行的代码如下：

Sub Seperate_Item_Code_And_Description_Code()
    'Copy/paste the item codes and descriptions from column B to column D and E seperately

    Range("B12").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("D12"), DataType:=xlFixedWidth, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    FieldInfo:=Array(Array(0, 1), Array(6, 1)), TrailingMinusNumbers:= _
    True
End Sub

Answer 1

试试这个编码和条件文本到列。

Option Explicit

Sub wqewtrqw()
    Dim s As Long, a As Long, aVALs As Variant

    With Worksheets("Sheet5")
        aVALs = .Range(.Cells(12, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Value2
        ReDim Preserve aVALs(LBound(aVALs, 1) To UBound(aVALs, 1), 1 To 2)
        For a = LBound(aVALs, 1) To UBound(aVALs, 1)
            s = InStr(1, aVALs(a, 1), Chr(32))
            aVALs(a, 2) = Mid(aVALs(a, 1), s + 1)
            aVALs(a, 1) = Left(aVALs(a, 1), s - 1)
        Next a
        .Cells(12, "D").Resize(UBound(aVALs, 1), UBound(aVALs, 2)) = aVALs
    End With
End Sub