VBA Excel 拆分地址列的IF條件

Question

我想將我的地址分成單獨的單元格。 我的地址由逗號組合，基本上，獨立單元格的數量取決於逗號。

我發現並實施了一個非常好的解決方案，它位於以下線程下：

在 Excel 中拆分地址字段

它有效，但主要條件是使字符串保持相同數量的逗號。

例如，如果地址如下所示：

1 - 40 Williams Court, 24-26 Poole Road, Bournemouth, BH4 9DT

那么就可以了（關於我的整個宏），

但是當地址更短時（在整個字符串中包括 2 個而不是 3 個逗號）

12 博伊德·克洛斯，考文垂，CV2 2NF

然后我又變得一團糟，如下所示：

所以我需要 if 語句，它可以讓我區分較短和較長的地址字符串。

我准備了一欄，我在其中定義了逗號的數量。

關於這一點，我嘗試實現以下代碼：

  Dim Wksht As Worksheet

  Dim MyArray() As String, myPath As String
  Dim lRow As Long, i As Long, j As Long, c As Long


  Set Wksht = ThisWorkbook.Sheets("Final")

  Set Wksht = ThisWorkbook.Sheets("Final")


  Sheets("Address").Application.Union(Columns("J"), Columns("P"), Columns("O")).Copy
  Wksht.Columns("A:B").PasteSpecial xlPasteValues

  Wksht.Columns("A").ColumnWidth = 60
  Wksht.Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

  Wksht.Columns("A:D").Insert Shift:=xlToRight, _
  CopyOrigin:=xlFormatFromLeftOrAbove


  Dim LastRow As Long, i As Long
  With Wksht
    LastRow = .Cells(.Rows.Count, "F").End(xlUp).row
  End With
  For i = 1 To LastRow
  If ActiveSheet.Range("U" & i) = 3 Then
   With Wksht
    lRow = .Range("E" & .Rows.Count).End(xlUp).row
    For i = 1 To lRow
        If InStr(1, .Range("E" & i).Value, ",", vbTextCompare) Then
            MyArray = Split(.Range("E" & i).Value, ",")
            c = 1
            For j = 0 To UBound(MyArray)
                .Cells(i, c).Value = MyArray(j)
                c = c + 1
            Next j
        End If
    Next i
   End With
   End If
  Next i

完全沒有錯誤。 調試器只顯示：

       If InStr(1, .Range("E" & i).Value, ",", vbTextCompare) Then

但我不明白，為什么我收到的是空欄。 為什么這段代碼根本不執行？

我希望這些地址根據單獨列中定義的逗號數量進行拆分。

更新：

這種方法也行不通

 For i = 1 To lLastRow
 If Wksht.Range("F" & i).Value = 2 Then
 Wksht.Range("C" & i).Value = Wksht.Range("D" & i).Value
 End If
 Next i

Answer 1

正如@Alex K. 所指出的，這是Text to Columns的設計目的。 請嘗試下面的代碼——它基於第二張圖片的數據布局（ E列中的原始數據）和名為Final的工作表。

Option Explicit
Sub Macro1()
Dim LastRow As Long, ws As Worksheet
Set ws = ThisWorkbook.Sheets("Final")
LastRow = ws.Cells(Rows.Count, 5).End(xlUp).Row

Application.DisplayAlerts = False   '<~~ to stop the warning if data already exists at the destination

ws.Range("E1:E" & LastRow).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1))

Application.DisplayAlerts = True

End Sub

編輯

如果您的目標純粹是將郵政編碼與地址的 rest 分開，您可以使用內置的InStrRev() function 根據字符串中最后一個逗號的位置（而不是逗號的數量）來實現這一點。

以下代碼假定完整地址在E列中，並將地址（減去郵政編碼）放在A列中，並將郵政編碼（減去地址的 rest）放在B列中。 所有在名為Final的工作表上。

Option Explicit
Sub SeparatePostCode()
Dim LastRow As Long, ws As Worksheet, c As Range, adr As String
Set ws = ThisWorkbook.Sheets("Final")
LastRow = ws.Cells(Rows.Count, 5).End(xlUp).Row

'Get the address minus the postcode
For Each c In ws.Range("A1:A" & LastRow)
    adr = c.Offset(0, 4).Value
    c.Value = Mid(adr, 1, Len(adr) - (Len(adr) - InStrRev(adr, ",") + 1))
Next c

'Get the postcode minus the address
For Each c In ws.Range("B1:B" & LastRow)
    adr = c.Offset(0, 3).Value
    c.Value = Right(adr, (Len(adr) - InStrRev(adr, ",") - 1))
Next c

End Sub