大家好，请教能不能统计出学号和座位号并改颜色，谢谢！

gzminge

chxw68 发表于 2024-5-1 12:09
写了个通用的，随意输入间隔天数。

老师在吗？你写的程序很好用，但是想请教一下，如果日期增加，比如100天，或者是1000天，下面应该怎么改：

Sub 每天()
    Dim r%, i%
    Dim arr, brr
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    ts = Application.InputBox(prompt:="请输入相隔天数", Title:="操作提示", Default:=0, Type:=1)
    With ActiveSheet
        r = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("c3:v" & r).Interior.Color = 16772537
        arr = .Range("c3:v" & r)
        ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
        For i = 1 To UBound(arr) - ts - 1
            d.RemoveAll
            For j = 1 To UBound(arr, 2)
                d(arr(i + ts + 1, j)) = Empty
            Next
            n = 0
            For j = 1 To UBound(arr, 2)
                If d.exists(arr(i, j)) Then
                    .Cells(i + 2, j + 2).Interior.ColorIndex = 3
                    n = n + 1
                    brr(i, n) = j
                End If
            Next
        Next
        .Range("x3").Resize(UBound(brr), UBound(brr, 2)) = brr
    End With
End Sub

chxw68

gzminge 发表于 2024-5-1 18:44
老师在吗？你写的程序很好用，但是想请教一下，如果日期增加，比如100天，或者是1000天，下面应该怎么改 ...

增加日期，也就是增行数据，不用修改代码的。