webinar
@webinar
Учим yii: https://youtu.be/-WRMlGHLgRg

Как решить такую задачу макросом?

Вот таблица:
1 а б в конец
2 г д е конец
3 ж з и конец
Вот код макроса:
Sub Tratata()

    Dim row As Long, column As Long, i As Long, k As Long
    row = 1
    column = 1
    k = 0
    Do While Len(Cells(row, column).Value) <> 0
    Sheets("11").Cells(row, column).Copy
    Sheets("22").Cells(k + 1, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Sheets("11").Cells(row, column + 1).Copy
    Sheets("22").Cells(k + 1, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        i = 2
        k = k + 1
        Do While i < 4
            Sheets("11").Cells(row, 1).Copy
            Sheets("22").Cells(row + k, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=True
            Sheets("11").Cells(row, column + i).Copy
            Sheets("22").Cells(row + k, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=True
            i = i + 1
            k = k + 1
        Loop
        row = row + 1
        Sheets("11").Select
    Loop
    
End Sub

Получаю:
1 а
1 б
1 в
2 г

2 д
3 ж


3 з
3 и
Есть пропуски пропуски и пустые строки ожидаю увидеть это:
1 а
1 б
1 в
2 г
2 д
2 е
3 ж
3 з
3 и
В чем я туплю? Vb знаю 2 часа. Так что не судите строго. Нужда толкнула и таблица в 150000 строк, которую нужно привести в порядок.
  • Вопрос задан
  • 301 просмотр
Решения вопроса 1
AnnTHony
@AnnTHony
Интроверт
Вот вам неймется :) пока с работы ехал еще вопрос придумали!
Пробуйте это:
Sub Macros()
    Dim i, j, counter As Integer
    
    counter = 1
    i = 1
    While Sheets("Лист1").Cells(i, 1) <> ""
        j = 2
        While Sheets("Лист1").Cells(i, j) <> ""
            Sheets("Лист2").Cells(counter, 1) = Sheets("Лист1").Cells(i, 1) & Sheets("Лист1").Cells(i, j)
            counter = counter + 1
            j = j + 1
        Wend
        i = i + 1
    Wend
End Sub


UpD:
Sub Macros()
    Dim i, j, counter As Integer
    
    counter = 1
    i = 1
    While Sheets("11").Cells(i, 1) <> ""
        j = 2
        While Sheets("11").Cells(i, j) <> "Конец"
            If Sheets("11").Cells(i, j) = "" Then
                j = j + 1
            Else
                Sheets("22").Cells(counter, 1) = Sheets("11").Cells(i, 1)
                Sheets("22").Cells(counter, 2) = Sheets("11").Cells(i, j)
                counter = counter + 1
                j = j + 1
            End If
        Wend
        i = i + 1
    Wend
End Sub
Ответ написан
Пригласить эксперта
Ваш ответ на вопрос

Войдите, чтобы написать ответ

Войти через центр авторизации
Похожие вопросы