Выборочное объединение строк Excel и удаление исходных строк - PullRequest
Новая
       30

Выборочное объединение строк Excel и удаление исходных строк

1 голос
/ 23 декабря 2011

У меня есть таблица Microsoft Excel (Mac 2011).

  1. Некоторые строки содержат данные в столбцах A, C, D, E, F и G. Я буду называть эти строки строками PARENT.

  2. В других строках есть данные только в столбце B. Я буду называть их строками CHILD. Каждая строка CHILD на самом деле является подмножеством строки PARENT над ней.

  3. Каждая строка PARENT имеет от 1 до 20 строк CHILD под ней.

  4. Схема обычно такова: СТРОКА РОДИТЕЛЯ, несколько СТРОК РЕБЕНКА под ним, затем еще одна СТРОКА РОДИТЕЛЯ, несколько СТРОК РЕБЕНКА ниже, затем еще одна СТРОКА РОДИТЕЛЯ и т. Д.

Я пытаюсь:

[a] Скопируйте содержимое каждой строки РОДИТЕЛЯ и добавьте их в строки РЕБЕНКА под ней.

[b] После копирования удалите исходную строку PARENT.

В электронной таблице содержится более 40 000 строк, и я не знаю, как создать макрос.

1 Ответ

0 голосов
/ 23 декабря 2011

На самом деле макрос вам не нужен (но я предоставил его снизу)

* 1003.

Ручное решение

  1. Выберите столбцы A, C, D и E (если вы сначала выберете столбец A)
  2. Нажмите F5 .... Перейти к Special и выберите Пробелы, а затем нажмите «ОК»
  3. В строке формул введите = A1, где A1 - это ячейка непосредственно над первой пустой ячейкой, начиная с шага 2 (см. Рисунок ниже, это ячейка A1)
  4. Нажмите одновременно клавиши Ctrl и Enter . Теперь у вас есть правильные данные в дочерних строках
  5. Выберите столбцы A: E и Скопируйте, затем Вставьте Special as Values, чтобы преобразовать формулы, которые вы только что ввели в дочерние строки, в значения
  6. Выбрать столбец B
  7. Нажмите F5 .... Перейдите в Special и выберите Пробелы, а затем нажмите «ОК» (см. Рис. Ниже)
  8. Удалить выделенные строки

Step 3 Step 7

Кодовое решение 

Sub Delete()
Dim rng1 As Range
Dim rng2 As Range
On Error Resume Next
Set rng1 = Range("A:A,C:E").SpecialCells(xlBlanks)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub
rng1.Formula = "=R[-1]C"
'handles two row areas else SpecialCells will force both areas to area1 formulae
For Each rng2 In rng1.Areas
rng2.Value = rng2.Value
Next rng2
On Error Resume Next
Set rng1 = Range("B:B").SpecialCells(xlBlanks)
On Error GoTo 0
If Not rng1 Is Nothing Then rng1.EntireRow.Delete
End Sub
...