Selecting values in one array based on another

2019-08-04 09:18发布

I've done some relatively straightforward things in VBA before but I think for this project I need to move into using variables and possibly arrays, which seem to be just beyond my reach at the moment.

I've got 4 columns of data: col. A is start times, col. B is the corresponding end times (there will be about 30 of each), col. C is time-stamps for the data points (collected during and between the time periods specified in columns A and B; there are 40,000+ lines of data in these columns), and col. D is the data observed at each time point referenced in col. C. Each file will have different start/end times, so I want to make a macro that can read them from the cells.

I need to put the time-stamp and data points from each time period specified in columns A and B, into separate columns (so, for example, time period 1 data will be in columns F and G, time period 2 data will be in H and I, and so on). So, I want to write a macro that will essentially search col. C for values that fall between the start and end times of the first time period, and copy/paste the relevant ones into the appropriate new columns.

I've been googling like crazy but I'm having a hard time putting together various pieces of code that can address the different steps. This is what I have so far (along with some notes saying what I think things are supposed to be doing):

Sub CopyRows2()

Dim endTime As Range, startTime As Range
Dim copyRange As Range, lastRow As Range, timePoint As Range
Dim i As Long, k As Long

    Set startTime = ActiveSheet.Cells(i, 2).Value
    lastRow = ActiveSheet.Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row  'find the last row of the time periods
    Set timePoint = ActiveSheet.Cells(2, 3)  'start looking for times in cell C2
  Do Until lastRow = ""
    For i = 2 To lastRow
       Set endTime = startTime.Offset(0, 1)   'identify the end of the time period
            If timePoint.Value >= startTime.Value Then    'find the row with the first data point in the time period
                If copyRange Is Nothing Then   'this "copyRange" stuff is based on: http://stackoverflow.com/questions/9790924/excel-vba-how-to-select-rows-based-on-data-in-a-column
                    Set copyRange = ActiveSheet.Rows(i)
                Else
                   Set copyRange = Union(copyRange, ActiveSheet.Rows(1))
                End If
            End If
        Next i
    If Not copyRange Is Nothing Then
        ActiveSheet.copyRange.Copy ActiveSheet.Cells(2, k)  'k is meant to be the column number, which will keep incrementing by 2 but I don't know how to tell it to do that
       End If
    Loop
End Sub

Right now it's giving me an error:

"Application-defined or object-defined error"

On this line:

Set startTime = ActiveSheet.Cells(i, 1).Value 

And I can't figure out why. But, I'm pretty sure that there are larger problems with it and it probably won't actually do what I'm trying to get it to do, even if I fix the problem that's causing the error.

At the moment the specific things I hope someone might be able to help with are:

  1. What is causing the error?

  2. How do I define k so that it will increment by 2 (see the note in the code above)

But, I know that there might be a much better way to do this -- if so, other suggestions would be much appreciated!

1条回答
Explosion°爆炸
2楼-- · 2019-08-04 09:37

Assumes data starts in row 2. Make sure Range D1 is not empty.

Sub CopyRows2()

Dim lastRow As Long
Dim lastCol As Long
Dim ws As Worksheet

'clear enough columns for ~30 data sets
Columns("E:CA").ClearContents

Set ws = Worksheets("Sheet2")
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
x = 2

With ws

    'fill columns A+B to correspond with C
    Do Until Cells(lastRow, 1) <> ""

        If .Cells(x, 2) <> .Cells(x, 3) Then
            .Range("A" & x + 1 & ":B" & x + 1).Insert Shift:=xlDown
            .Cells(x + 1, 1) = .Cells(x, 1)
            .Cells(x + 1, 2) = .Cells(x, 2)
        End If

        x = x + 1

    Loop

    'move blocks
    i = 2
    c = 1


    Do Until i > lastRow

        'change in column A
        If .Cells(i + 1, 1) <> .Cells(i, 1) Then
            .Range("c" & i - c + 1 & ":D" & i).Copy
            lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
            .Cells(1, lastCol + 1).PasteSpecial
            c = 0
        End If

        i = i + 1
        c = c + 1

    Loop

End With

End Sub
查看更多
登录 后发表回答