当前位置: 动力学知识库 > 问答 > 编程问答 >

excel - Selecting multiple data ranges if condition is satisfied

问题描述:

I am trying to get data from an Excel sheet. If the date indicated on the column header is today's date then contents of that column need to be copied. After checking all the columns, the final data needs to be pasted in another sheet.

I have built a macro to get stock prices from web. Now I need to filter the data based on date to make it ready for making graphs. I have tried multiple variations of the below code but till now no success. Copying the ranges is the problem area.

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

网友答案:

You need to set the new range

For example

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

or

     Set newRng = Union(rng1, rng2)

So you need to set r

set r = Union(r, Range(Cells(1, x), Cells(50, x))) 
分享给朋友:
您可能感兴趣的文章:
随机阅读: