Excel数字和框问题

Question

我有一个excel文件，里面装满了我需要在我们的系统中导入的地址。 的housenumber列的格式是这样的： 普通门牌号码只显示有一定boxnumber数量，但门牌号码显示是这样的：25 B12 我需要得到boxnumbers（如果存在的话）中的另一列

我设法做到这一点与这些功能

Function GetBus(Text As String, ByRef NumberCell As Range) As String 
     Dim LastWord As String 
     LastWord = ReturnLastWord(Text) 

     If Left(LastWord, 1) = "B" Then 

      GetBus = Right(LastWord, Len(LastWord) - 1) 


     Else 
      GetBus = "" 
     End If 

    End Function 



    Function ReturnLastWord(Text As String) As String 
     Dim LastWord As String 
     LastWord = StrReverse(Text) 
     LastWord = Left(LastWord, InStr(1, LastWord, " ", vbTextCompare)) 
     ReturnLastWord = StrReverse(Trim(LastWord)) 
    End Function 

因此创建带有框值的新列正在工作。什么是行不通的是删除数字列中的盒子部分（fe：如果数值是25 B1 B1部分应该被删除）

任何想法如何做到这一点，或者这是不可能在Excel中？

Answer 1

这是我几年前写的东西，所以我不确定它是否有错误，但快速测试似乎表明它正常工作。您可能需要对其进行更改才能使其完全适用于您的情况。

代码：

Option Explicit 

Sub SplitAddress() 
    Dim MyAr() As String, tempStr As String, strUnique As String 
    Dim lRow As Long, i As Long, j As Long, lRow2 As Long 
    Dim cell As Range 

    strUnique = "SiddR" & Format(Now, "ddmmyyhhmmss") 

    With ActiveSheet 
     .Columns("A:A").Replace What:=" ", Replacement:=strUnique, LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 

     lRow = .Range("A" & .Rows.Count).End(xlUp).Row 

     .Columns("C").NumberFormat = "@" 
     .Columns("D").NumberFormat = "@" 

     For i = 2 To lRow 
      MyAr = Split(.Range("A" & i).Value, strUnique) 

      tempStr = "" 

      For j = LBound(MyAr) To (UBound(MyAr) - 1) 
       If tempStr = "" Then 
        tempStr = MyAr(j) 
       Else 
        tempStr = tempStr & " " & MyAr(j) 
       End If 
      Next j 

      .Range("B" & i).Value = tempStr 
      .Range("C" & i).Value = MyAr(UBound(MyAr)) 
     Next i 

     For i = 2 To lRow 
      If Not IsNumeric(.Range("C" & i).Value) Then 
       tempStr = "" 
       For j = 1 To Len(.Range("C" & i).Value) 
        If IsNumeric(Mid(.Range("C" & i).Value, j, 1)) Then 
         If tempStr = "" Then 
          tempStr = Mid(.Range("C" & i).Value, j, 1) 
         Else 
          tempStr = tempStr & Mid(.Range("C" & i).Value, j, 1) 
         End If 
        Else 
         Exit For 
        End If 
       Next 
       .Range("D" & i).Value = Mid(.Range("C" & i).Value, j) 
       .Range("C" & i).Value = tempStr 

       If Len(Trim(tempStr)) = 0 Then 
        MyAr = Split(.Range("A" & i).Value, strUnique) 

        .Range("C" & i).Value = MyAr(UBound(MyAr) - 1) 
       End If 
      End If 

     Next 

     .Columns("A:A").Replace What:=strUnique, Replacement:=" ", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 

     .Columns("D:D").Replace What:="-", Replacement:="", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 
    End With 
End Sub 

截图：

截图：

随着您的测试数据

编辑：现在，当我在这段代码再看看，我看到，它可以大大大大进一步优化:)