程序代码：

Sub 单双供应商选择()
    Dim i&, eRow&, rq%, DS%, Gys$, arr, d As Object
    '日期除以3的余数 DS
    Set d = CreateObject("Scripting.Dictionary")
    d(1 & "井道材料") = "利昌"
    d(1 & "导轨") = "蒙特费罗"
    d(1 & "侧梁") = "利昌"
    d(1 & "承重梁") = "利昌"
    d(1 & "对重架&对重轮") = "兆元"
    d(1 & "机器底座") = "利昌"
    d(1 & "主机底座") = "利昌"
    d(1 & "绳轮") = "兆元"
    
    d(2 & "井道材料") = "永德"
    d(2 & "导轨") = "西豪"
    d(2 & "侧梁") = "永德"
    d(2 & "承重梁") = "永德"
    d(2 & "对重架&对重轮") = "永德"
    d(2 & "机器底座") = "永德"
    d(2 & "主机底座") = "永德"
    d(2 & "绳轮") = "永德"
    
    d(0 & "井道材料") = "利昌"
    d(0 & "导轨") = "永方"
    d(0 & "侧梁") = "利昌"
    d(0 & "承重梁") = "利昌"
    d(0 & "对重架&对重轮") = "兆元"
    d(0 & "机器底座") = "利昌"
    d(0 & "主机底座") = "利昌"
    d(0 & "绳轮") = "兆元"
    
    eRow = Cells(Rows.Count, 1).End(3).Row
    If eRow < 2 Then Exit Sub
    arr = Range("A2:V" & eRow)
    ReDim brr(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arr)
        If IsDate(arr(i, 22)) Then
            rq = Day(arr(i, 22)): DS = rq Mod 3

        '   If rq Mod 2 = 1 Then DS = 1 Else DS = 2
        ' 修改: 拟实现以下规则:
        ' 如果日期能被3整队,则导轨供应商= 永方
        ' 如果日期能除3余2, 则导轨供应商= 西豪
        ' 如果日期能除3余1, 则导轨供应商= 蒙特费罗

            Gys = d(DS & Trim(arr(i, 1)))
            If Len(Gys) Then brr(i, 1) = Gys Else brr(i, 1) = arr(i, 19)
        End If
    Next
    [s2].Resize(UBound(brr)) = brr
End Sub