Question

在Excel电子表格订购表单中，有一列高度。它们需要采用3位数字格式：500,506,510等。我需要一个宏来转换此列中的值以遵循该格式。

我创建了这些Subs，它确实有效，但它很慢并且有时会崩溃Excel。我希望有一些更简单的东西可以更快地运行。

Sub FixHeights()
    Dim c As Range

    For Each c In Selection.Cells
        Selection.NumberFormat = "General"
        c = Replace(c, " ", "")
        c = Replace(c, "'", "")
        c = Replace(c, Chr(96), "")
        c = Replace(c, Chr(34), "")
        c = Replace(c, Chr(191), "")
        c = Replace(c, "'0", "")
        c = Replace(c, "'00", "")
    Next

    Call FixHeights2

End Sub

Sub FixHeights2()
    Dim c As Range

    For Each c In Selection.Cells
        Selection.NumberFormat = "General"
        c = Replace(c, "40", "400")
        c = Replace(c, "41", "401")
        c = Replace(c, "42", "402")
        c = Replace(c, "43", "403")
        c = Replace(c, "44", "404")
        c = Replace(c, "45", "405")
        c = Replace(c, "46", "406")
        c = Replace(c, "47", "407")
        c = Replace(c, "48", "408")
        c = Replace(c, "49", "409")
        c = Replace(c, "50", "500")
        c = Replace(c, "51", "501")
        c = Replace(c, "52", "502")
        c = Replace(c, "53", "503")
        c = Replace(c, "54", "504")
        c = Replace(c, "55", "505")
        c = Replace(c, "56", "506")
        c = Replace(c, "57", "507")
        c = Replace(c, "58", "508")
        c = Replace(c, "59", "509")
        c = Replace(c, "60", "600")
        c = Replace(c, "61", "601")
        c = Replace(c, "62", "602")
        c = Replace(c, "63", "603")
        c = Replace(c, "64", "603")
        c = Replace(c, "65", "605")
        c = Replace(c, "66", "606")
        c = Replace(c, "67", "607")
        c = Replace(c, "68", "608")
        c = Replace(c, "69", "609")
        c = Replace(c, "70", "700")
        c = Replace(c, "3010", "310")
        c = Replace(c, "4010", "410")
        c = Replace(c, "5010", "510")
        c = Replace(c, "6010", "610")
        c = Replace(c, "3011", "311")
        c = Replace(c, "4011", "411")
        c = Replace(c, "5011", "511")
        c = Replace(c, "6011", "611")
    Next
End Sub

我的代码删除了空格，撇号，引号和＆＃39; 0和＆＃39; 00的实例。然后，它将结果值转换为有效值。

以下是需要转换的内容的一些示例。基本上，需要取出空格，引号和撇号。它们都需要3位数字：508,510,600等。 5＆＃39; 6＆＃34; 5＆＃39; 6 5＆＃39; 10＆＃34;

Answer 1

无需对每个单元格值执行重复替换。在最好的情况下，您只会匹配其中一个。最糟糕的情况是您匹配 more 而不是一个，这意味着您的输出将是不正确的。我只是使用正则表达式，然后格式化匹配：

'Requires a reference to Microsoft VBScript Regular Expressions x.x
Sub FixHeights()
    Dim c As Range
    With New RegExp
        Dim matches As MatchCollection
        .Pattern = "(\d+)\s*['`]\s*(\d+)"
        For Each c In Selection.Cells
            c.NumberFormat = "General"
            Set matches = .Execute(c.Value)
            If matches.Count = 1 Then 
                c.Value = CInt(matches.Item(0).SubMatches(0)) & _
                      Format$(CInt(matches.Item(0).SubMatches(1)), "00")
            End If
        Next
    End With
End Sub

VBA代码转换高度

1 个答案: