2

У меня есть документ Excel, такой как этот, со многими списками:

Name
Address
City, State
ZIP

Name
Address
City, State
ZIP

Между ними есть пустая строка. Как я могу преобразовать это во что-то вроде:

Name, Address, City, Sate, ZIP
Name, Address, City, Sate, ZIP

Я провел некоторое исследование, и макросы, кажется, дают ошибки. Специальная паста также позволяет мне делать только один за другим.

2 ответа2

6

Вам не нужны макросы для этого!

Просто введите это в Sheet2 и измените имя листа в формулах:

  • A1: = OFFSET(Лист1!$ A $ 1,(СТРОКА ()- 1)* 6,0)
  • A2: = OFFSET(Лист1!$ A $ 1,(СТРОКА ()- 1)* 6+1,0)
  • A3: = СМЕЩЕНИЕ (Лист1!$ A $ 1,(СТРОКА ()- 1)* 6+2,0)
  • A4: = СМЕЩЕНИЕ (Лист1!$ A $ 1,(СТРОКА ()- 1)* 6+3,0)
  • A5: = OFFSET(Лист1!$ A $ 1,(СТРОКА ()- 1)* 6+4,0)

Затем отметьте записи, которые вы только что сделали, и перетащите их вниз, сколько потребуется. Готово!

1

Я ответил на это пару дней назад, но мой ответ, похоже, был утерян. Возможно, я неправильно разместил сообщение, так как я новичок в этом сайте.

Я не жил в Штатах с конца 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

Надеюсь это поможет

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .