使用vbscript拆分excel单元格

Question

GIVEN：我正在尝试使用 VBScript 重新排列数据在 Excel 文档中的呈现方式。我知道数据将始终采用以下格式：

       A      |               B              |  C  |  D  
--------------|------------------------------|-----|-----
1 ANGLE       | 6 x 3-1/2 x 5-16 x 240       |  1  | C1054
2 SQAURE TUBE | 1-1/2 x 1-1/2 x 1/8 x 31-3/4 |  3  | C1588
3 DOM TUBE    | 5-1/2 OD x 1" WALL           |  4  | C1670

目标：我的目标是把它变成这种格式：

                 A                |    B    |  C  |   D
----------------------------------|---------|-----|-------
1 6 X 3-1/2 X 5-16 ANGLE          | 240     |  1  | C1054
2 1-1/2 X 1-1/2 X 1/8 SQAURE TUBE | 31-3/4  |  3  | C1588
3 5-1/2 OD X 1" WALL DOM TUBE     |         |  4  | C1670

我的想法是首先在 B 列和 C 列之间插入空白列。然后，我将使用 split 命令将 B 列拆分为带有小“x”的中间步骤：

       A      |     B    |    C    |   D  |    E   | F |  G    
--------------|----------|---------|------|--------|---|-------
1 ANGLE       | 6        | 3-1/2   | 5-16 | 240    | 1 | C1054
2 SQAURE TUBE | 1-1/2    | 1-1/2   | 1/8  | 31-3/4 | 3 | C1588
3 DOM TUBE    | 5-1/2 OD | 1" WALL |      |        | 4 | C1670

接下来，我将 A 列移动到 D 列和 E 列之间。然后我将使用“X”以某种方式将这些数字混合在一起，然后将该列与下一个混合以达到目标。

我在vbscript中的代码是：

'inserting 3 blank columns into given format
objSheet2.Columns("C:C").Insert xlToRight
objSheet2.Columns("C:C").Insert xlToRight
objSheet2.Columns("C:C").Insert xlToRight
'splitting
Split objSheet2.Columns("B:B"),"x"
'objSheet2.Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
'        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
'        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
'        :="x", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2)), _
'        TrailingMinusNumbers:=True
'moving column A between column E and F
objSheet2.Columns("A:A").Cut
objSheet2.Columns("F:F").Insert

我首先录制了一个宏，然后随便将其粘贴到我的 vbscript 中，这显然不起作用，这就是我将其注释掉的原因。 split 命令也不起作用。在运行期间，我在拆分行的开头收到类型不匹配错误。请注意，第 3 行中的信息比其他行少一条。

问题：如何使用 VBScript 以及可能的拆分命令从给定格式中得出我的目标格式？

Answer 1

您可以只检查单元格值中有多少个“x”，并相应地更新列 A 和 B 中的单元格值，而不是拆分整列

For Each cell In objSheet2.UsedRange.Resize(, 1)     ' column A
    a = Split( cell.Offset(0, 1).Value , " x ", 4 )  ' the cell in column B
    If UBound(a) > 2 Then                            ' if more than 2 " x "
        cell.Value = a(0) & " X " & a(1) & " X " & a(2) & " " & cell.Value
        cell.Offset(0, 1).Value = "'" & a(3)
    Else
        cell.Value = Replace( cell.Offset(0, 1).Value, " x ", " X " ) & " " & cell.Value
        cell.Offset(0, 1).Value = ""
    End If
Next

Answer 2

我会采取不同的做法。 使用 VBA 数组通常比处理大量工作表内容要快

• 将源数据读入二维 vba 数组
• 使用正则表达式，当且仅当它与下面的正则表达式模式匹配时，处理第二列以删除最后一项。
• 将“缩短的”测量值与源列 1 中的描述连接起来，并将其放入结果列 1。
• 从捕获的最后一项测量中删除“x”和空格，并将其放入结果列 2。
• 将原始第三列和第四列复制到结果数组中。
• 将结果数组写入新工作表，并进行一些格式化。 （可以通过仅更改结果工作表来覆盖原始数据）。

这似乎正如您在发布的数据中所描述的那样有效：

Option Explicit
Sub ReFormat()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim I As Long
    Dim RE As Object, MC As Object

'set worksheets for source and results
Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet2")
    Set rRes = wsRes.Cells(1, 1)

'read source data into variant array
With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 4).End(xlUp))
End With

'create results array
ReDim vRes(1 To UBound(vSrc, 1), 1 To UBound(vSrc, 2))

'Initialize Regex
Set RE = CreateObject("vbscript.regexp")
With RE
    .Global = True
    .ignorecase = True
    .Pattern = "\s+x\s+(\d[-./\d]*\d\b)\s*(?!.*x)"
End With

'Cycle through the rows
For I = 1 To UBound(vSrc, 1)
    vRes(I, 1) = Trim(RE.Replace(vSrc(I, 2), "")) & "  " & vSrc(I, 1)
    Set MC = RE.Execute(vSrc(I, 2))
        If MC.Count = 1 Then vRes(I, 2) = MC(0).submatches(0)
    vRes(I, 3) = vSrc(I, 3)
    vRes(I, 4) = vSrc(I, 4)
Next I

'write the results
Set rRes = rRes.Resize(UBound(vRes, 1), UBound(vRes, 2))
With rRes
    .EntireColumn.Clear
    .Value = vRes
    .Columns(2).HorizontalAlignment = xlCenter
    .EntireColumn.AutoFit
End With

End Sub

以及正则表达式模式描述：

\s+x\s+(\d[-./\d]*\d\b)\s*(?!.*x)

• Match a single character that is a “whitespace character”\s+
  • Between one and unlimited times, as many times as possible, giving back as needed (greedy)+
• Match the character “x” literallyx
• Match a single character that is a “whitespace character”\s+
  • Between one and unlimited times, as many times as possible, giving back as needed (greedy)+
• Match the regex below and capture its match into backreference number 1(\d[-./\d]*\d\b)
  • Match a single character that is a “digit”\d
  • Match a single character present in the list below[-./\d]*
    • Between zero and unlimited times, as many times as possible, giving back as needed (greedy)*
    • A single character from the list “-./”-./
    • A “digit”\d
  • Match a single character that is a “digit”\d
  • Assert position at a word boundary\b
• Match a single character that is a “whitespace character”\s*
  • Between zero and unlimited times, as many times as possible, giving back as needed (greedy)*
• Assert that it is impossible to match the regex below starting at this position (negative lookahead)(?!.*x)
  • Match any single character that is NOT a line break character.*
    • Between zero and unlimited times, as many times as possible, giving back as needed (greedy)*
  • Match the character “x” literallyx

使用RegexBuddy创建