将不同的单元格组合到同一行

I want each record on the same row:

我希望每一条记录在同一行:

Row 1 Column 1: Parcel Number,  Row 1 Column 2: Owner Name, Row 1 Column 3: Address

SAMPLE :

Parcel Record 21033540290000 Owner Doe, John M, SR. & Jane H; TRS Address 2116 W Wall St Parcel Record 21033540450000 Owner Brown, MARSHA & GREEN, MARIE; JT Address 2131 W Harvard Ave Parcel Record 21033230450000 Owner Smith, MICHELLE K Address 4281 S Yale Ave

包裹记录21033540290000所有者Doe,John M,SR。 &简H; TRS地址2116 W Wall St Parcel Record 21033540450000所有者Brown,MARSHA&GREEN,MARIE; JT地址2131 W Harvard Ave包裹记录21033230450000所有者Smith,MICHELLE K地址4281 S耶鲁大道

I would like the format to be on the same row with 3 columns:

我希望格式在3列的同一行:

21033540290000  Doe, John M, SR. & Jane H; TRS          2116 W Wall St
21033540450000  Brown, MARSHA & GREEN, MARIE; JT        2131 W Harvard Ave
21033230450000  Smith, MICHELLE K                       4281 S Yale Ave

Then delete the Owner and Address rows after the data is copied to the same row as the Parcel number.

然后在将数据复制到与宗地编号相同的行后删除所有者和地址行。

Have recorded a macro, but have problem looping & referencing cells and rows. Sub FormatRows() ' ' FormatRows Macro ' Formats to same row ' ' Keyboard Shortcut: Ctrl+f

记录了一个宏,但是循环和引用单元格和行有问题。 Sub FormatRows()''FormatRows Macro'格式化为同一行''键盘快捷键:Ctrl + f

Range("B1").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("B2").Select
Selection.Cut
Range("B1").Select
ActiveSheet.Paste
Range("B3").Select
Selection.Cut
Range("C1").Select
ActiveSheet.Paste
Rows("2:2").Select
Selection.Delete Shift:=xlUp
Selection.Delete Shift:=xlUp
Range("B2").Select
Selection.Cut
Range("A2").Select
ActiveSheet.Paste
Range("B3").Select
Selection.Cut
Range("B2").Select
ActiveSheet.Paste
Range("B4").Select
Selection.Cut
Range("C2").Select
ActiveSheet.Paste
Rows("3:3").Select
Selection.Delete Shift:=xlUp
Selection.Delete Shift:=xlUp
Range("B3").Select
Selection.Cut
Range("A3").Select
ActiveSheet.Paste
Range("B4").Select
Selection.Cut
Range("B3").Select
ActiveSheet.Paste
Range("B5").Select
Selection.Cut
Range("C3").Select
ActiveSheet.Paste
Rows("4:4").Select
Selection.Delete Shift:=xlUp
Selection.Delete Shift:=xlUp
Range("B4").Select

End Sub

' How can I get this to loop thru a couple thousand rows?

'我怎么能让这个循环通过几千行?

Thank you!

1 个解决方案

#1

This would require string processing

这将需要字符串处理

Step 1: Find the number part:

第1步:找到数字部分:

Dim strTemp As String
Dim strChar As String
strTemp = "Parcel Record 21033540290000 Owner Doe, John M, SR. & Jane H; TRS Address 2116 W Wall St "


flag = True
i = 1
On Error GoTo lblEnd:
While flag = True
    strChar = Strings.Mid(strTemp, i, 1)
    If IsNumeric(strChar) Then
        'your code here
    End If
    i = i + 1
Wend

lblEnd:
Err.Clear

Step 2: Find "," and ":". Just change the if part of the previous code:

第2步:找到“,”和“:”。只需更改上一代码的if部分:

 If strChar = "," Then
     'your code here
 End If

and this:

 If strChar = ":" Then
     'your code here
 End If

#1