Как переставить базу данных Excel из 1 длинной строки в 3 короткие строки неравной длины и автоматически повторить процесс?

Question

Этот вопрос является расширением / продолжением моего предыдущего вопроса в разделе Как переставить базу данных Excel из 1 длинной строки в 3 короткие строки и автоматически повторить процесс? на что ответил Джейсон Льюис, которому я благодарен. Но, будучи фиктивной в функции «Косвенного» Excel, мне снова нужна помощь:

Например:- На листе А строка 1 содержит следующие данные в каждой ячейке (всего занято 72 ячейки):

А1 В1 С1 D1 Е1 F1, G1, H1 I1 J1 K1 L1 M1 N1 О1 Р1 Q1 R1 S1, T1 U1 V1 W1 X1 Y1 Z1 АА1 АВ1 АС1 АД1 AE1 AF1 AG1 AH1 АВХ1 AJ1 АК1 AL1 AM1 AN1 АВЫХ1 ТЧД1 AQ1 АПВ1 AS1 АТ1 AU1 AV1 AW1 AX1 AY1 AZ1 BA1 BB1 BC1 BD1 BE1 BF1 BG1 BH1 BI1 BJ1 BK1 BL1 BM1 BN1 BO1 BP1 BQ1 BR1 BS1 BT1

Переустанавливать на лист Б в следующем формате:

Ряд 1: A1 B1 C1 D1 E1 F1 G1 H1 I1 J1 K1 L1 M1 N1 O1 P1 Q1 R1 S1 T1 U1 V1 W1 X1 Y1 Z1 AA1 AB1 AC1 AD1 AE1 AF1 AG1 AH1 AI1

Ряд 2: AJ1 AK1 AL1 AM1 AN1 AO1 AP1 AQ1 AR1 AS1 AT1 AU1 AV1 AW1 AX1 AY1 AZ1 BA1 BB1 BC1 BD1 BE1 BF1 BG1 BH1 BI1 BJ1 BK1

Ряд 3: BL1 BM1 BN1 BO1 BP1 BQ1 BR1 BS1 BT1

Лист A (лист базы данных) имеет много строк (например, 3000 строк, в каждой строке по 72 ячейки, занятые данными), следовательно, лист B (переформатированная база данных) оценивается в 9000 строк (то есть 3 x 3000) неравной длины ,

Благодарю вас в ожидании вашего скорого ответа.

Answer 1

Этот макрос сделает это

Sub AnotherGo()

Dim row As Integer
row = 1

Dim row2 As Integer
row2 = 1

Do While (True)

If (Worksheets("Sheet1").Range("A" & row) = "") Then
Exit Do
End If

Worksheets("Sheet2").Range("A" & row2 & ":AI" & row2).Value = Worksheets("Sheet1").Range("A" & row & ":AI" & row).Value
Worksheets("Sheet2").Range("A" & row2 + 1 & ":AB" & row2 + 1).Value = Worksheets("Sheet1").Range("AJ" & row & ":BK" & row).Value
Worksheets("Sheet2").Range("A" & row2 + 2 & ":I" & row2 + 2).Value = Worksheets("Sheet1").Range("BL" & row & ":BT" & row).Value

row = row + 1
row2 = row2 + 3

Loop

End Sub

У меня есть 3 строки в Sheet1

А лист 2 выглядит так (после запуска макроса)