Номер Excel и полевые вопросы

Question

У меня есть файл excel, полный адресов, которые мне нужно импортировать в нашу систему. столбец номер дома отформатирован так: Нормальные номера домов просто показывают номер, но дом номер с определенной 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 

Скриншот:

Скриншот:

С вашими данными испытаний

EDIT: Теперь, когда я снова смотрю на этот код, я вижу, что он может быть оптимизирован многое дальше :)