excel - 根据条件从列中复制所有数据

问题描述

我已经为这个问题苦苦挣扎了整整一个月...

这是重点。我在 excel 中有一张名为的表格，其中在从单元格到单元格Amounts的列下列出了许多数据。最后一列可能每天都在变化。这些不同的数据上面有名字，可以让我知道数据的类型。10A2J2

无论如何，有许多列的标题以以下 value 开头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

你能帮我解决这个问题吗...？我觉得答案是如此明显，就像我脸上的鼻子一样。

标签： excelvba

尝试这个。我已经对代码进行了注释，因此您理解它应该没有问题。

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

值得一读

excel - 根据条件从列中复制所有数据

问题描述

解决方案

推荐阅读