Скопируйте все данные из столбца на основе условия

Mido88

1 июля 2021 в 19:20

179

Я боролся с этой проблемой целый месяц...

Вот в чем дело. У меня есть лист в excel под названием Amounts, где есть много данных, перечисленных в столбцах 10 из ячейки A2 в ячейку J2. Последний столбец может меняться изо дня в день. Над этими разными данными есть заголовки, которые позволяют мне узнать тип данных.

Во всяком случае, во многих столбцах заголовок начинается со следующего значения Amount of (date). Я хочу сделать код, который;

Позволяет мне автоматически искать все имена столбцов, которые начинаются со значения Amount of
Скопируйте все данные ниже (от первых данных до последних). Диапазон данных в каждом столбце может меняться изо дня в день.
И, наконец, вставьте все данные диапазона, скопированные под заголовком столбца, на другой лист и в один столбец (начиная с cel(1,1)).

Вот как выглядит мой текущий код;

Dim cel As Range
With Sheets("Amounts")
    Worksheets("Amounts").Activate

    For Each cel In Range("A2", Range("A2").End(xlToRight)
        If cel.Value Like "Amount in USD *" Then
            cel.Offset(1).Select
            Range(Selection, Selection.End(xlDown)).Select
                        
            Selection.Copy Worksheets("Pasted Amounts").Range("A2")
        End If
    Next cel

Не могли бы вы помочь мне с этим...? Я чувствую, что ответ так же очевиден, как нос посреди моего лица.

excel
vba

Источник

Поделиться Скопировать ссылку Скопировано

Ответы (1)

Siddharth Rout

1 июля 2021 в 19:43

Попробуйте это. Я прокомментировал код, поэтому у вас не должно возникнуть проблем с его пониманием.

Option Explicit

Sub Sample()
    Dim wsInput As Worksheet
    Dim wsOutput As Worksheet
    Dim lRowInput As Long
    Dim lRowOutput As Long
    Dim lCol As Long
    Dim i As Long
    Dim Col As String
    
    '~~> Set your sheets here
    Set wsInput = Sheets("Amounts")
    Set wsOutput = Sheets("Pasted Amounts")
    
    With wsInput
        '~~> Find last column in Row 2
        lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
        
        '~~> Loop through columns
        For i = 1 To lCol
            '~~> Check for your criteria
            If .Cells(2, i).Value2 Like "Amount in functional currency*" Then
                '~~> Get column name
                Col = Split(.Cells(, i).Address, "$")(1)
                
                '~~> Get the last row in that column
                lRowInput = .Range(Col & .Rows.Count).End(xlUp).Row
                
                '~~> Find the next row to write to
                If lRowOutput = 0 Then
                    lRowOutput = 2
                Else
                    lRowOutput = wsOutput.Range("A" & wsOutput.Rows.Count).End(xlUp).Row + 1
                End If
                
                '~~> Copy the data
                .Range(Col & "3:" & Col & lRowInput).Copy _
                wsOutput.Range("A" & lRowOutput)
            End If
        Next i
    End With
End Sub

Стоит прочитать

Поделиться Скопировать ссылку Скопировано

Mido88

1 июля 2021 в 19:51

Привет! Боже мой вы так быстро ответили, спасибо!! Это сработало так хорошо! Однако, как только VBA вставил данные, он вставил их в 3-ю строку столбца A. Как я могу вставить его во 2-ю строку столбца A (на листах («Вставленные суммы»), пожалуйста? Еще раз большое спасибо, Сиддхарт!

Siddharth Rout

1 июля 2021 в 20:05

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

Mido88

1 июля 2021 в 20:22

Да работало отлично! Огромное спасибо!! Это полностью то, что я хочу, да :)