0

システムにインポートする必要がある住所でいっぱいの Excel ファイルがあります。housenumber 列は次のようにフォーマットされています: 通常の house numbers は番号を表示するだけですが、特定の boxnumber を持つ house number は次のように表示されます: 25 B12 boxnumber (存在する場合) を別の列で取得する必要があります

私はこれらの機能でこれを行うことができました

  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 に答える