excel 2016中的VB宏用于按多列分组

Question

我有以下输入：

我想写一个宏，首先按城市分组，然后用车号分组。在输出中，我想要从MIN（开始日期）到Max（结束日期）的列，并且每行都是唯一的车号。每当汽车被占用时，将其标记为红色，否则为绿色。

期望的输出：

我知道逻辑但是如何在宏中实现我不知道。

Answer 1

首先，为什么要将“城市”存储在重复的表格中？它似乎与汽车相关联，如果是这样，那么只需将它存储在汽车/城市/日期表中，如果它必须在另一个表中，则使用vlookup。这将节省潜在的错误......

在回答您的问题时，以下是我如何设置表来测试这一点，您必须调整以下代码以适应您的数据布局：

首先，将表格中的所有单元格格式化为绿色/可用。然后，此宏将更改所有已预订的单元格。

Sub bookings()

' This finds the number of rows in the top table (-1 for heading row)
Dim numCars As Integer
numCars = ActiveSheet.Range("A1").End(xlDown) - 1

' Tracks the active car row
Dim carRow As Integer

' Cells for first row/colum cells in tables
Dim dateCell As Range
Dim bookingCell As Range

' cycle through the bookings table (bottom)
For Each bookingCell In ActiveSheet.Range("A10:" & ActiveSheet.Range("A10").End(xlDown).Address)

    ' Find which row in top table belongs to this booking's car. Could cause error if doesn't exist!
    carRow = ActiveSheet.Columns(1).Find(what:=bookingCell.Offset(0, 1).Value, lookat:=xlWhole, LookIn:=xlValues).Row

    ' Cycle through dates in top table for comparison
    For Each dateCell In Range("C1:" & ActiveSheet.Range("C1").End(xlToRight).Address)

        ' Comparison like this will only work on dates stored properly (not as text)
        ' If this isn't working, convert your dates by multipling them by 1.
        ' This can be done in a neighbouring cell like =A1*1, then copying values
        ' See this link for details:
        ' http://stackoverflow.com/questions/6877027/how-to-convert-and-compare-a-date-string-to-a-date-in-excel

        ' If the date lies between the booking dates...
        If dateCell.Value >= bookingCell.Offset(0, 2).Value _
            And dateCell.Value <= bookingCell.Offset(0, 3).Value Then

            With ActiveSheet.Cells(carRow, dateCell.Column)


                ' Do a check that no manual change has happened
                if .value = "Available" then 

                    ' Change the text to booked and colour to red
                    .Value = "Booked"
                    .Interior.Color = RGB(200, 0, 0)

                end if

            End With

        End If

    Next dateCell

Next bookingCell

End Sub