Excel VBA - 如何选择与先前单元格中的值对应的范围？

Question

我有一组非常大的数据，其中包括 NAS 中飞机的开始和停止时间。我想创建一个宏来在 excel 中对这些数据进行可视化表示，如下所示：

（注意：此图片使用假数据）

如您所见，我已经手动完成了前 7 行，但是有几个数据文件，每个文件多达 2500 多行，这使得这个过程很乏味。我尝试创建一个宏，但我很困惑如何搜索和选择要突出显示的适当范围。

这是我目前所拥有的：

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

选择我需要的行的最简单方法是什么？

我不是专业的程序员；如果我的代码展示了草率的技术或违反了一些神圣的编程原则，请提前道歉。 :P

谢谢！

Answer 1

这是我在 VBA 上的尝试。

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

Answer 2

条件格式解决方案怎么样？

突出显示从 H2 到（右下角最后一个单元格）的所有单元格。

使用这个公式：

=IF(AND((H$1>$E2),(H$1<$F2)),TRUE)

然后应用填充。如果您愿意放弃填充范围内的边框和名称，它会为您工作:)。

此外，您可能希望从 G2 冻结窗格，这样您就可以一直滚动到 HJ 列并仍然看到 Callsign 列。

希望对你有帮助