Excel VBA: получить список данных в другом столбце - PullRequest
Новая
       15

Excel VBA: получить список данных в другом столбце

0 голосов
/ 05 сентября 2018

В настоящее время я создаю автоматизацию для автоматизации некоторых задач. В основном у меня есть эти данные:

enter image description here

Моя цель - перевести все счета на другой лист (Лист 2).

Проблема: я не могу отобразить название банка вместе с номером счета под ними. Так как название банка всегда пустое.

Номер банка и счета может расти, в этом случае я хотел, чтобы он был динамичным. Однако, когда я попытался добавить номер счета в последнем банке, он перестал вставлять дополнительный номер счета. Также, если код также может быть улучшен?

Подводя итог, я хотел получить список номеров счетов в банке. Получив его, я буду выполнять некоторые другие задачи, прежде чем он перейдет на другой банк и номер счета. Но я еще не включил в код ниже: 

Sub test1()

Dim lRow As Long

lRow = Cells(Rows.Count, 1).End(xlUp).Row

Range("B2").Select

For i = 2 To lRow

    ActiveSheet.Cells(i, 2).Select

    If ActiveCell.Offset(1, -1).Value = "" Then

            ActiveCell.Copy
            Sheets("Sheet2").Select
            ActiveSheet.Paste
            ActiveCell.Offset(1.1).Select
            Sheets("Sheet1").Select


    Else
        ActiveCell.Copy
        Sheets("Sheet2").Select
        ActiveSheet.Paste
        ActiveCell.Offset(1.1).Select
        Sheets("Sheet1").Select

        'I need to to insert other steps here
        MsgBox "New Bank. Need to do other steps"

    End If

Next i

End Sub

Желаемый результат:

enter image description here

1 Ответ

0 голосов
/ 05 сентября 2018

Вы можете попробовать код ниже. Обновите ссылки на листы, где это необходимо! 

Public Sub CopyToSecondSheet()
    Dim wksSource As Worksheet: Set wksSource = ThisWorkbook.Sheets("Sheet1")
    Dim wksDestin As Worksheet: Set wksDestin = ThisWorkbook.Sheets("Sheet2")
    Dim i As Long
    Dim strBankName as String
    Application.ScreenUpdating = False
    wksDestin.Range("A1:A" & wksDestin.Range("A" & wksDestin.Rows.Count).End(xlUp).Row).Delete xlUp
    For i = 2 To wksSource.Range("B" & wksSource.Rows.Count).End(xlUp).Row
        If Len(wksSource.Range("A" & i).Value) > 0 Then
            If Len(strBankName) > 0 Then Msgbox "Finished copying records for : " & strBankName, vbOKOnly
            strBankName = wksSource.Range("A" & i).Value
            wksSource.Range("A" & i).Copy wksDestin.Range("A" & wksDestin.Rows.Count).End(xlUp).Offset(1, 0)
        End If
        wksSource.Range("B" & i).Copy wksDestin.Range("A" & wksDestin.Rows.Count).End(xlUp).Offset(1, 0)
    Next
    Msgbox "Update completed!", vbInformation
    Application.ScreenUpdating = True
End Sub
...