试图提高我的 VBA 代码的质量和效率

Question

我有 50,000 个姓名和地址字符串，每个字符串占用一个单元格。为了将单元格拆分为不同的名称、街道编号、街道、城市等，我试图将单元格拆分为与街道编号和街道名称匹配的列。

• E列中的所有单元格示例：

  行列：E

  1. 分开。 56 Johnston Terrace Keyham 路
  2. 沃尔斯利路 90 号和 92 号
  3. 2 安斯利露台
  4. Dyer & Cleaner 10 & 12 Mount Gold Road
  5. 亚历山大路 48b 号
  6. 奶农斯特拉瑟姆修道院路

• NewCell 列中的结果；

  行。 Col.F |上校 | Col.H

  1. 分开。| 56 | Johnston Terrace Keyham 路
  2. '*' | 90 & 92 |沃尔斯利路
  3. '*' | 2 |安斯利露台
  4. 染色剂和清洁剂 | 10 & 12 |金山路
  5. '*' | 48b |亚历山大路
  6. 奶农 | '*' |斯特拉瑟姆修道院路

目前我的Excel Sheet没有具体的列名，只有A；乙; C 等。我有将每个单元格分开的 VBA 代码。但是，街道编号和/或街道名称将根据每个单元格中的“textnumbertext”字符串进行不同的拆分。
我有单独的 VBA 代码，可以在任何以街道号开头的条目前添加一个星号（请参阅代码）。然后将每个单元格放在正确的列中（我可以稍后删除星号）。但是，我觉得这段代码效率低下，如果我使用 Case 函数，可能会不那么冗长。

更复杂的是，一些街道编号将是 14A 或 12B 或 10c 或 12a。如果我将这些选项添加到下面的代码中，那么一切都会变得冗长且效率低下。请问有什么想法吗？

Sub ReplaceFirstNumber()
'If the first character in the string starts with a number between 1-9 THEN 
'ADD a * to the string
Dim r As Range
Dim c As Range
On Error Resume Next
Set r = Range(Range("E1"), Range("E" & Rows.Count).End(xlDown))
    For Each c In r
     If Left(c.Value, 1) = "1" _
     Or Left(c.Value, 1) = "2" _
     Or Left(c.Value, 1) = "3" _
     Or Left(c.Value, 1) = "4" _
     Or Left(c.Value, 1) = "5" _
     Or Left(c.Value, 1) = "6" _
     Or Left(c.Value, 1) = "7" _
     Or Left(c.Value, 1) = "8" _
     Or Left(c.Value, 1) = "9" Then
     c.Value = " * " & c.Value
    End If
   Next c
End Sub

Answer 1

希望下面的功能可以帮助您使这项任务变得更容易一些。它会从地址字符串中去除所有数字字符，并将包括任何尾随的单个字母。

Function getnumbersfromstring(address As String) As String
    For i = 1 To Len(address)
        If IsNumeric(Mid(address, i, 1)) Then getnumbersfromstring = getnumbersfromstring & Mid(address, i, 1) 
    Next i

    CharAfterNumber = Mid(address, Instr(1, address, getnumbersfromstring) + Len(getnumbersfromstring), 1)
    If IsNumeric(CharAfterNumber) = False And Not CharAfterNumber = " " And Not CharAfterNumber = "" Then
        getnumbersfromstring = getnumbersfromstring & CharAfterNumber
    End If
End Function

这个函数可以像这样在普通的 Sub 中调用

Sub breakupaddress()

Dim r As Range
Dim c As Range
Dim addressnr As String

On Error Resume Next
Set r = Range(Range("E1"), Range("E" & Rows.Count).End(xlDown))
    For Each c In r
        addressnr = getnumbersfromstring(c.Value)
        MsgBox "The address number is '" & addressnr & "'.", vbInformation, "Information"
    Next c
End Sub 

Answer 2

我很好奇您将如何编写所有代码，但关于您的问题，可能可行的方法是：

Sub ReplaceFirstNumber()
'If the first character in the string starts with a number between 1-9 THEN 
'ADD a * to the string
Dim r As Range
Dim c As Range
Set r = Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row)
    For Each c In r
     If IsNumeric(Left(c.Value, 1))=True Then c.Value = "*" & c.Value
   Next c
End Sub

在您的代码中使用Range(Range("E1"), Range("E" & Rows.Count).End(xlDown))。这意味着E 列中的所有单元格！。这就像 Excel 2007 或更高版本中的一百万个单元格。在我的代码中，范围是 Set r = Range("E1:E" & Range("E" & Rows.Count).End(xlUp).Row) 这将只选择 E1 和 E 列中最后一个非空白单元格之间的所有单元格，因此如果您只有 50.000 行数据。

另外，如果您正在学习 VBA，我强烈建议您不要使用 On Error Resume Next 语句，因为它隐藏了错误，但它们仍然会发生。

希望您最终可以编写此代码，或者至少觉得此答案很有帮助。

但不管怎样，你还有很多代码要写。