Excel VBA - 如何选择与先前单元格中的值对应的范围？ [英] Excel VBA - How do I select a range corresponding to values in previous cells?

问题描述

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

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

正如你所看到的，我手头完成了前7行，但是多个数据文件多达2500行，每一行使得过程繁琐。我试图创建一个宏，但是我很困惑如何搜索并选择适当的范围来突出显示。

这是我到目前为止：

  Sub autofill（）
 
 Dim rng As Range 
 Dim row As Range 
 Dim单元格作为范围
 
'设置整个搜索区域的范围
设置rng =范围（A2：HJ121）
 
对于每行在rng.Rows 
 Dim callign As Variant 
 Set callsign = cell（contents，A& row）
 Dim valstart As Variant 
设置valstart = cell（contents， E& row）
 Dim valstop As Variant 
设置valstop = cell（contents，F& row）
 
'现在选择从列的标题与valstart中的
'时间匹配，并在与valstop中的时间匹配的时间结束
 
 Selection.Merge 
 Selection.Style =突出显示
 Selection.Value =呼号
下一行
 
 End Sub 
  

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

我不是专业的程序员;如果我的代码显示草率的技术或违反了一些神圣的规划原则，则提前道歉。 ：P

谢谢！

解决方案

这个。

  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 
 
设置ws = ActiveSheet 
 
 startCol = ws.Range（H：H）。列
 endCol = ws.Range（HJ：HJ）。列
 
调用clearFormats 
 
对于i = 2到ws.Cells（1，1）.End（xlDown ）.Row 
 entryTime = ws.Cells（i，5）.Value 
 exitTime = ws.Cells（i，6）.Value 
设置formatRange = Nothing 
 
对于j = startCol To endCol 
如果（ws.Cells（1，j）.Value> exitTime）然后
退出对于
结束如果
 
 If （entryTime< ws .Cells（1，j）.Value）And（ws.Cells（1，j）.Value< exitTime））然后
如果（formatRange不是）然后
设置formatRange = ws.Cells（i，j）
 Else 
设置formatRange = formatRange.Resize（，formatRange.Columns .Count + 1）
 End If 
 End If 
 Next j 
 
 If（Not formatRange Is Nothing）Then 
调用格式TheRange（formatRange，ws。单元格（i，A）。
 End If 
 Next i 
 End Sub 
 
 Private Sub clearFormats（）
 With ActiveSheet.Range （H2：HJ121）
 .clearFormats 
 .ClearContents 
结束
 
 End Sub 
私有子格式TheRange（ByRef r As Excel.Range， ByRef callign As String）
 
 r.Horizo​​ntalAlignment = xlCenter 
 r.Merge 
 
 r.Value =呼号
 
'应用颜色
与r.Interior 
 .Pattern = xlSolid 
 .PatternColorIndex = xlAutomatic 
 .ThemeColor = xlThemeColorLight2 
 .TintAndShade = 0.799981688894314 
 .PatternTintAndShade = 0 
结束
 
'应用边框
带有r.Borders（xlEdgeLeft）
 .LineStyle = xlContinuous 
 .ColorIndex = 0 
 .TintAndShade = 0 
 .Weight = xlThin 
结束
带有r.Borders（xlEdgeTop）
 .LineStyle = xlContinuous 
 .ColorIndex = 0 
 .TintAndShade = 0 
 .Weight = xlThin 
结束
带r.Borders（xlEdgeBottom）
 .LineStyle = xlContinuous 
 .ColorIndex = 0 
 .TintAndShade = 0 
 .Weight = xlThin 
结束
带r.Borders（xlEdgeRight）
。 LineStyle = xlContinuous 
 .ColorIndex = 0 
 .TintAndShade = 0 
 .Weight = xlThin 
 End with 
 End Sub 
  

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!

解决方案

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

这篇关于Excel VBA - 如何选择与先前单元格中的值对应的范围？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！