创建临时工作簿。向下扫描输入数据，将每行复制到新工作簿中的相应列。然后保存为CSV并关闭临时工作簿。

Option Explicit

Sub CreateCSV()

   Const CSVNAME = "clients.csv"
   
   Dim wbCSV As Workbook, wsCSV As Worksheet, rCSV As Long
   Dim lastrow As Long, r As Long, c As Long, n As Long
   Dim CSVfullname As String, ar
   
   ' temp workbook to save as CSV
   Set wbCSV = Workbooks.Add(1)
   Set wsCSV = wbCSV.Sheets(1)
   
   'scan addresses
   With ThisWorkbook.Sheets(1)
       lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
       
       r = 1
       Do While r <= lastrow
            If Len(.Cells(r, 1)) = 0 Then
                r = r + 1
            Else
                ' copy next 6 lines to csv sheet
                rCSV = rCSV + 1
                For c = 1 To 4
                    If c = 4 Then
                        ' split 4th line into 3 columns
                        ar = Split(.Cells(r, 1), ",")
                        For n = 0 To UBound(ar)
                            wsCSV.Cells(rCSV, c + n) = ar(n)
                        Next
                    Else
                        wsCSV.Cells(rCSV, c) = .Cells(r, 1)
                    End If
                    r = r + 1
                Next
          End If
       Loop
   End With
   
   ' save temp workbook
   CSVfullname = ThisWorkbook.path & "\" & CSVNAME
   wbCSV.SaveAs CSVfullname, FileFormat:=xlCSV
   wbCSV.Close savechanges:=False
   
   ' result
   MsgBox rCSV & " records saved to " & CSVfullname, vbInformation
End Sub

字符串

我相信有更干净的方法，但这是一个简单的方法。复制地址'的范围（假设公寓不存在，则有一个单元格为空），然后将其转置（注意：不能在复制区域的顶部转置）。删除原始复制的地址，并根据需要拆分城市、州和邮编。

Private Sub tester()
    Dim ws As Worksheet
    Set ws = Worksheets("test")
    Dim rng As Range
    Set rng = ws.Range("A1:A4")
    Dim pasted As Range
    Set pasted = ws.Range("B1")
    
    Dim parts() As String
    Dim temp As String
    Dim i As Integer
    
    rng.Copy
    ws.Range("B1:E1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, _
    Transpose:=True
    rng.ClearContents
    
    temp = Replace(pasted.Offset(0, 3).Value, ",", "")
    parts = Split(temp, " ")
    
    For i = 0 To UBound(parts)
        pasted.Offset(0, i + 3) = parts(i)
    Next i
    
    If pasted.Offset(0, 2).Value = "" Then
        pasted.Offset(0, 2).Delete
    End If
    
End Sub

字符串
编辑：重写代码以适用于场景