VBA代码转换高度

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

我创build了这些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 

我的代码去掉空格，撇号，引号和'0和'00的实例。 然后，它将结果值转换为有效的值。

以下是一些需要转换的例子。 基本上，空格，引号和撇号需要被取出。 他们都需要三位数字：508,510,600等。5'6“5'6 5'10”

Answer 1

不需要对每个单元格值进行重复replace。 在最好的情况下，你只能匹配其中的一个。 最糟糕的情况是你匹配多个 ，这意味着你的输出将是不正确的。 我只是使用正则expression式，然后格式化匹配：

 'Requires a reference to Microsoft VBScript Regular Expressions xx 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