使用 Excel 2010 中的巨集對姓名電話資料進行從行到列的排序

Question

我想拆分我的資料並按名稱、地址、城市、州和電話的列排列，但名稱沒有將所有資料加入同一行，您能幫我解決這個問題嗎？以下是宏代碼，謝謝

Sub ExtractDataFromTextFile()
  Dim strFilename, strTextLine, tState, tZip, tCity, tAddress, tCityState  As String
  Dim iFile, iRow, ChkName, ChkAddress, ChkPhone As Integer
  Dim SplitAddress, TempAddressSplit As Variant
'ChkScrapLine1, ChkScrapLine2, ChkScrapLine3, ChkScrapLine4, ChkScrapLine5, ChkScrapLine6, ChkScrapLine7, ChkScrapLine8, ChkScrapLine9, ChkScrapLine10

  'text file path
  strFilename = "C:\Users\Wasim\Desktop\N.txt"

  'Set how many rows you want to leave on top of data
  iRow = 1

  iFile = FreeFile
  Open strFilename For Input As #iFile

  Do Until EOF(1)
    Line Input #1, strTextLine

    strTextLine = Application.WorksheetFunction.Clean(strTextLine)
    strTextLine = Application.WorksheetFunction.Trim(strTextLine)


    If Len(strTextLine) > 1 Then

        ChkScrapLine1 = InStr(LCase(strTextLine), "confirm")
        ChkScrapLine2 = InStr(UCase(strTextLine), "SPONSORED")
        ChkScrapLine3 = InStr(LCase(strTextLine), "more")
        ChkScrapLine4 = InStr(LCase(strTextLine), "background")
        ChkScrapLine5 = InStr(LCase(strTextLine), "find")
        ChkScrapLine6 = InStr(UCase(strTextLine), "TRY")
        ChkScrapLine7 = InStr(UCase(strTextLine), "get")
        ChkScrapLine8 = InStr(LCase(strTextLine), "listing")
        ChkScrapLine9 = InStr(LCase(strTextLine), "search")
        If ChkScrapLine1 = 0 And ChkScrapLine2 = 0 And ChkScrapLine3 = 0 And ChkScrapLine4 = 0 And ChkScrapLine5 = 0 And ChkScrapLine6 = 0 And ChkScrapLine7 = 0 And ChkScrapLine8 = 0 And ChkScrapLine9 = 0 Then
            ChkAddress = InStr(strTextLine, ",")
            ChkPhone = InStr(strTextLine, "(")
            If ChkAddress > 0 Then
strTextLine = Replace(strTextLine, ", ", ",")
                SplitAddress = Split(strTextLine, ",")
                tAddress = SplitAddress(0)
                tCity = SplitAddress(1)

                Cells(iRow, 3).Value = strTextLine

            ElseIf ChkPhone > 0 Then
                Cells(iRow, 4).Value = strTextLine
            Else
                iRow = iRow + 1
                Cells(iRow, 1).Value = strTextLine
            End If

        End If
    End If
  Loop
  Close #iFile

End Sub