Я ответил на это пару дней назад, но мой ответ, похоже, был утерян. Возможно, я неправильно разместил сообщение, так как я новичок в этом сайте.
Я не жил в Штатах с конца 1970-х годов, но два наших адреса в Детройте имели разное количество строк. Решение по формуле основано на том, что каждый адрес имеет одинаковое количество строк, поэтому я не считаю его адекватным решением.
Я поместил следующие английские адреса в Sheet1. Первый типичный адрес в Великобритании. Два других являются реальными (кроме имени и почтового индекса), но менее обычными. Вторым является адрес в деревенском стиле с домами, названными вместо пронумерованных, и местный город, включенный в дополнение к названию деревни. Третий адрес наиболее необычен, так как не имеет названия улицы. Как следует из адреса, дом был построен в руинах того, что когда-то было западным фронтом аббатства Бери-Сент-Эдмундс.
John Smith
5 Acacia Avenue
York
Yorkshire
YO3 2RG
Sarah Jones
Lilac Cottage
Chapel Lane
Houghton
Huntingdon
Cambridgeshire
CB12 4TG
Alice Green
1 The West Front
Abbey Ruins
Bury St Edmunds
IP33 1RS
Следующий макрос скопирует эти адреса в Sheet2 в нужном вам стиле.
Sub Test2()
Dim Col1Crnt As Integer
Dim Col1Max As Integer
Dim Col2Crnt As Integer
Dim Sheet1() As Variant
Dim Row1Crnt As Integer
Dim Row1Max As Integer
Dim Row2Crnt As Integer
With Sheets("Sheet1")
' Find the last used row in Sheet1
Row1Max = .Cells.Find("*", .Range("A1"), xlFormulas, _
, xlByRows, xlPrevious).Row
' Load column 1 to Sheet1.
Sheet1 = .Range(.Cells(1, 1), .Cells(Row1Max, 1)).Value
' Although I am only loading one column, Sheet 1 will be a 2D array
' with the row as the first dimension and the column as the second.
' I have loaded Sheet1 to an array because switching between
' worksheets is very slow.
End With
With Sheets("Sheet2")
Row2Crnt = 1
Col2Crnt = 1
For Row1Crnt = 1 To Row1Max
If Sheet1(Row1Crnt, 1) = "" Then
' blank line
If Col2Crnt <> 1 Then
' Only advance row for first blank row
Row2Crnt = Row2Crnt + 1
Col2Crnt = 1
End If
Else
.Cells(Row2Crnt, Col2Crnt).Value = Sheet1(Row1Crnt, 1)
Col2Crnt = Col2Crnt + 1
End If
Next
End With
End Sub
Надеюсь это поможет