Excel VBA - How do I select a range corresponding to values in previous cells?

问题

I have a very large set of data that includes start and stop times for aircraft in the NAS. I want to create a macro to make a visual representation of this data in excel, like the following:

(note: this image uses fake data)

As you can see I've done the first 7 rows by hand, but there are several data files with as many as 2500+ rows each which makes the process tedious. I've tried to create a macro but I'm confused how to search for and select the appropriate range to highlight.

Here's what I have so far:

Sub autofill()

    Dim rng As Range
    Dim row As Range
    Dim cell As Range

    'set the range of the whole search area
    Set rng = Range("A2:HJ121")

    For Each row In rng.Rows
        Dim callsign As Variant
        Set callsign = cell("contents", "A" & row)
        Dim valstart As Variant
        Set valstart = cell("contents", "E" & row)
        Dim valstop As Variant
        Set valstop = cell("contents", "F" & row)

        'now select the range beginning from the column whose header matches the
        'time in valstart and ends at the time which matches the time in valstop

        Selection.Merge
        Selection.Style = "Highlight"
        Selection.Value = callsign
    Next row

End Sub

What's the easiest way of selecting the rows I need?

I'm not a programmer by profession; apologies in advance if my code demonstrates sloppy technique or violates some holy programming principles. :P

Thanks!

回答1:

Here's my go at VBA for this.

Option Explicit

Public Sub fillSchedule()
    Dim startCol As Long
    Dim endCol As Long
    Dim i As Long
    Dim j As Long

    Dim ws As Excel.Worksheet
    Dim entryTime As Single
    Dim exitTime As Single
    Dim formatRange As Excel.Range

    Set ws = ActiveSheet

    startCol = ws.Range("H:H").Column
    endCol = ws.Range("HJ:HJ").Column

    Call clearFormats

    For i = 2 To ws.Cells(1, 1).End(xlDown).Row
        entryTime = ws.Cells(i, 5).Value
        exitTime = ws.Cells(i, 6).Value
        Set formatRange = Nothing

        For j = startCol To endCol
            If (ws.Cells(1, j).Value > exitTime) Then
                Exit For
            End If

            If ((entryTime < ws.Cells(1, j).Value) And (ws.Cells(1, j).Value < exitTime)) Then
                If (formatRange Is Nothing) Then
                    Set formatRange = ws.Cells(i, j)
                Else
                    Set formatRange = formatRange.Resize(, formatRange.Columns.Count + 1)
                End If
            End If
        Next j

        If (Not formatRange Is Nothing) Then
            Call formatTheRange(formatRange, ws.Cells(i, "A").Value)
        End If
    Next i
End Sub

Private Sub clearFormats()
    With ActiveSheet.Range("H2:HJ121")
        .clearFormats
        .ClearContents
    End With

End Sub
Private Sub formatTheRange(ByRef r As Excel.Range, ByRef callsign As String)

    r.HorizontalAlignment = xlCenter
    r.Merge

    r.Value = callsign

    ' Apply color
    With r.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With

    ' Apply borders
    With r.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With r.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With r.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With r.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub