如果條件滿足，選擇多個數據範圍

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)))