Excel编号和框问题

Question

我有一个充满地址的excel文件，我需要在我们的系统中导入。 housenumber列的格式如下： 正常的房屋号码只显示数字，但带有特定箱号的房屋号码如下所示：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

<强>截图：

<强>截图：

使用您的测试数据

编辑：现在，当我再次查看此代码时，我发现它可以进一步优化：）