Question

我正在尝试从Excel工作表中获取数据。如果列标题上指示的日期是今天的日期，则需要复制该列的内容。检查完所有列后，最终数据需要粘贴到另一张表中。

我已经建立了一个宏来从网上获取股票价格。现在我需要根据日期过滤数据，以便为制作图表做好准备。我尝试了以下代码的多种变体，但到目前为止还没有成功。复制范围是问题所在。

Sub graphs()

Dim d As Date
Dim a As Variant
Dim f As Variant
Dim b As Variant
Dim x As Variant
Dim col As Variant
Dim r As Range
Dim j As Range


r = ThisWorkbook.Sheets("historic price").Range(Cells(1, 1), Cells(50, 1)) ' this is to copy the first column with company names


b = WorksheetFunction.CountA(Rows(1))

For x = 2 To b

    a = ThisWorkbook.Sheets("historic price").Cells(1, x)   ' below 3 lines are to extract date from column header
    f = WorksheetFunction.Search(" ", a, 10)
    d = Mid(a, 10, (f - 10))

    If d = Date Then


    r = Union(r, Range(Cells(1, x), Cells(50, x))) ' this is to add data to r


    End If

Next x

col = r.Columns.Count    ' count number of columns stored in r

r.Copy


Worksheets("graphs").Activate

Set j = ThisWorkbook.Sheets("Graphs").Range(Cells(1, 1), Cells(50, col))

j.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
ThisWorkbook.Sheets("Graphs").Cells(1, 1).Select


End Sub

Answer 1

您需要设置新范围

例如

Set rng1 = .Range("A1")
 Set rng2 = .Range("A2")
 Set NewRng = .Range(rng1.Address & ":" & rng2.Address)

或

     Set newRng = Union(rng1, rng2)

所以你需要设置r

set r = Union(r, Range(Cells(1, x), Cells(50, x)))

如果满足条件，则选择多个数据范围

1 个答案: