![使用 Excel 2010 中的宏将姓名电话数据从行排序到列](https://linux22.com/image/1510374/%E4%BD%BF%E7%94%A8%20Excel%202010%20%E4%B8%AD%E7%9A%84%E5%AE%8F%E5%B0%86%E5%A7%93%E5%90%8D%E7%94%B5%E8%AF%9D%E6%95%B0%E6%8D%AE%E4%BB%8E%E8%A1%8C%E6%8E%92%E5%BA%8F%E5%88%B0%E5%88%97.png)
我想拆分我的数据并按姓名、地址、城市、州和电话的列排列,但姓名没有将所有数据合并在同一行,你能帮我修复它吗?以下是宏代码,谢谢
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