1

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

ありがとう！

4

2 に答える 2

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
于 2012-11-15T23:16:04.627 に答える
0

条件付きフォーマットソリューションはどうですか？

H2から（右下の最後のセル）までのすべてのセルを強調表示します。

次の式を使用します。

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

次に、塗りつぶしを適用します。そして、あなたが塗りつぶされた範囲内の境界線と名前をあきらめることをいとわないなら、それはあなたのために働くでしょう:)。

また、G2からペインをフリーズして、HJ列までスクロールしても、コールサイン列が表示されるようにすることもできます。

お役に立てれば

于 2012-11-15T21:23:05.533 に答える