范围宏不起作用

如何解决范围宏不起作用

。

以下宏（CollectProjectItems）的设计功能。在宏（CollectContractorItems）中应用相同的逻辑（但更改了范围）无法正常工作。

我认为错误是我所忽略的，当然……对于我的生命……我无法识别我的错误。

需要新鲜的眼睛。

提前谢谢您。

Sub UpdateCharts()
    CollectProjectItems
    CollectContractorItems
End Sub

Sub CollectProjectItems()
On Error Resume Next
    MyDate = Format(Date,"mmm") & "-" & Right(Year(Date),2)
    For Each cl In Range("A3",Range("A" & Rows.Count).End(xlUp))
        wproj = Application.Match(cl.Value,Columns(10),0)
        
        If IsNumeric(wproj) Then
            MyMonth = Application.Match(MyDate,Rows(wproj + 1),0)
            Cells(wproj + 2,MyMonth) = cl.Offset(,1)
            Cells(wproj + 3,2)
        End If
    Next
End Sub

Sub CollectContractorItems()
On Error Resume Next
    MyDate = Format(Date,2)
    For Each cl In Range("E3",Range("E" & Rows.Count).End(xlUp))
        wproj = Application.Match(cl.Value,Columns(25),2)
        End If
    Next
End Sub

第二个宏未完成Col AG中的所需编辑。它将复制与Col R的第一个宏相同的编辑。

我不知道如何更改第二个宏，因此它会影响Cols Z：AK中的编辑。

???

下载示例工作簿：Macro Error

解决方法

赞：

Sub CollectContractorItems()
    Const COL_CONTRACTORS As Long = 25
    Dim MyDate As String,cl As Range,ws As Worksheet,wproj,MyMonth
    Dim rngDates As Range,dtCol As Long

    Set ws = ActiveSheet 'or some specific sheet
    MyDate = Format(Date,"mmm") & "-" & Right(Year(Date),2)

    For Each cl In ws.Range("E3:E" & ws.Cells(ws.Rows.Count,"E").End(xlUp).Row).Cells
        wproj = Application.Match(cl.Value,ws.Columns(COL_CONTRACTORS),0)
        
        If Not IsError(wproj) Then
            'get the range with dates
            Set rngDates = ws.Cells(wproj,COL_CONTRACTORS).Offset(1,1).Resize(1,12)
            MyMonth = Application.Match(MyDate,rngDates,0) 'search only in the specific range
            If Not IsError(MyMonth) Then
                dtCol = rngDates.Cells(MyMonth).Column 'get the column number
                ws.Cells(wproj + 2,dtCol) = cl.Offset(,1)
                ws.Cells(wproj + 3,2)
            End If
        End If
    Next
End Sub