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 

截圖：

截圖：

隨着您的測試數據

編輯：現在，當我在這段代碼再看看，我看到，它可以大大大大進一步優化:)