0

我有一个 excel 文件，里面有我需要在我们的系统中导入的地址。门牌号列的格式如下： 普通门牌号只显示数字，但具有特定箱号的门牌号显示如下： 25 B12 我需要在另一列中获取箱号（如果存在）

我设法用这些功能做到了这一点

  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 中是不可能的？

4

1 回答 1

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

截图：

在此处输入图像描述

截图：

使用您的测试数据

在此处输入图像描述

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

于 2013-04-04T09:18:08.947 回答