excel VBA突出显示每周/每季度的日期范围

mcdcgff0 于 2023-03-20 发布在其他

关注(0)|答案(2)|浏览(226)

我需要一些帮助，用宏来突出显示一些日期范围。我觉得这是一个简单的解决方案，但我不能绕着它转。我的工作遵循特定的日历周，期间和季度。周当然是从星期日到星期六的7天，期间有点不同，他们正好是4或5周，季度总是3个期间的4周，4周，5周。我必须定期运行报表，并且希望以不同的颜色突出显示每个期间（仅HeaderRowRange）。目前，我将期间的第一个日期和周数硬编码到字典中，以便对其进行格式化。这不是最佳的，因为我必须不断地使用新日期更新代码。

到目前为止，我认为我可以将开始日期设置为2023年1月1日，然后除以91，得到四分之一，并从每个四分之一点偏移回来，但我不知道如何处理工作表上第一个四分之一之前或最后一个四分之一之后的单元格，我一直觉得我还遗漏了另一种方法，但我的大脑不会把它拉出来，有人有什么想法吗？

Sub Split()
    ActiveSheet.Name = "MPS"
    'Objects
    Dim ws As Worksheet: Set ws = Worksheets("MPS")
    Dim tbl As ListObject: Set tbl = ws.ListObjects(1)
    tbl.Name = "Schedule"
    Dim xRng, cell As Range
    
    'Array
    Dim qtrs(1 To 4) As Range
    
    'Variables
    Dim TargetDate, StartDate As Long: StartDate = DateValue("1/1/2023")
    Dim DateFactor As Double
    Dim x As Long
    
    Set xRng = tbl.HeaderRowRange(, 3).Resize(1, lCol - 2)
    x = 1
    For Each cell In xRng
        DateFactor = (DateValue(cell) - StartDate) / 91
        On Error Resume Next
        If DateFactor = Int(DateFactor) Then
            Set qtrs(x) = cell
            x = x + 1
        End If
    Next cell

    For x = 4 To 1 Step -1
        BLARGH!

End Sub

excel

来源：https://stackoverflow.com/questions/75750972/vba-highlighting-weekly-quarterly-date-ranges

2条答案

按热度按时间

cqoc49vn1#

从外观上看，您需要每个季度使用不同的颜色，并且在您的数据中，季度不只是1/1/2023 - 3/31/2023，而是按周划分。一年的前13周：第1季度，第14-26周，第2季度，第3季度27-39周，第4季度40-53周。
如果是这种情况，您可能不应该使用VBA（在VBA中可以使用，而且可能非常简单），但为什么不使用条件格式呢？例如：

我在条件格式中使用了以下3个公式，这些公式适用于=$1：$1（第1行）。
第一季度：=AND(WEEKNUM(A1)<=13,A1<>"")
第二季度：=AND(WEEKNUM(A1)>13,WEEKNUM(A1)<=26,A1<>"")
第三季度：=AND(WEEKNUM(A1)>26,WEEKNUM(A1)<=39,A1<>"")

第四季度的最后公式为：
=AND(WEEKNUM(A1)>39,WEEKNUM(A1)<=53,A1<>"")

赞(0）回复(0）举报 2023-03-20

o4tp2gmn2#

我不知道WEEKNUM函数，这让我想到了一个解决方案。

Sub Split()
ActiveSheet.Name = "MPS"
'Objects
Dim ws As Worksheet: Set ws = Worksheets("MPS")
Dim tbl As ListObject: Set tbl = ws.ListObjects(1)
tbl.Name = "Schedule"
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim xRng, Cell As Range

'Variables
Dim lCol, i As Long

'builds dictionary object with the starting day of each period as key and number
'of weeks as key
dict.Add 1, 4
dict.Add 5, 4
dict.Add 9, 5
dict.Add 14, 4
dict.Add 18, 4
dict.Add 22, 5
dict.Add 27, 4
dict.Add 31, 4
dict.Add 35, 5
dict.Add 40, 4
dict.Add 44, 4
dict.Add 48, 5

'Searches the header row for dates listed in the dictionary and highlights them by
'the number of months in the period
lCol = tbl.ListColumns.Count
Set xRng = tbl.HeaderRowRange(, 4).Resize(1, lCol - 3)
x = 41
For Each Cell In xRng
    i = Application.WorksheetFunction.WeekNum(DateValue(Cell), 2)
    If dict.exists(i) Then
        Cell.Resize(, dict(i)).Interior.ColorIndex = x
        x = x + 1
    End If
Next

tbl.Range.Columns.AutoFit

末端子组件

赞(0）回复(0）举报 2023-03-20

我来回答

excel VBA突出显示每周/每季度的日期范围

2条答案

相关问题

热门标签

最新问答