excel Object Variable or With Block Variable Not Set Error(在所有字段中查找特定列中的所有非空单元格)

fafcakar  于 2023-11-20  发布在  其他
关注(0)|答案(1)|浏览(81)

这是我的代码

'Looping Each Worksheet and Check Whether They Are Project Tabs

    Dim ws As Worksheet                                          'Variable - Looping All Worksheets
    Dim wsName As String                                         'Variable - Get Worksheet Name

    Dim ReFCell_CostCode_Header As Range                         'Variable - Locate "Cost Code" Cell
    Dim ReFCell_CostCode_Letter As String                        'Variable - Get "Cost Code" Cell Letter
    Dim ReFCell_CostCode_ColAddress As String                    'Variable - Get "Cost Code" Cell Address

    Dim ReFCell_FirstCell_Address As String                       'Variable - Break Looping Within one Worksheet (FirstCell Address)

    Dim Cost_Code As Range                                        'Variable - Store CostCode Value

    Dim ProjectName As Range                                     'Variable - Save Project Name Value
    Dim StoreName As Range                                       'Variable - Save Store Name Value

    Dim i As Long                                                'Variable - Copy Cost Code to The Right Place

    i = 2

    For Each ws In ThisWorkbook.Worksheets
    
        'Get Worksheet Name
        wsName = ws.Name
        
        'Check Tab's Name Contain #
        If Not IsNumeric(Mid(ws.Name, 1, 1)) Then
            GoTo NextWorksheet

        'Locate Cost Code Header & Loop Each Indivisual Cost Code
        Else

            'Get Cost Code Header Column Address Within the Worksheet
            Set ReFCell_CostCode_Header = ws.UsedRange.Find("Cost Code", MatchCase:=True)
            ReFCell_CostCode_Letter = Split(ReFCell_CostCode_Header.Address, "$")(1)
            ReFCell_CostCode_ColAddress = ReFCell_CostCode_Letter & ":" & ReFCell_CostCode_Letter

            'Record The First Cost Code Item Address
            Set Cost_Code = ws.Range(ReFCell_CostCode_ColAddress).Find("*", after:=Range(ReFCell_CostCode_Header.Address))
            ReFCell_FirstCell_Address = Cost_Code.Address

            'Save Project Name & StoreName
            Set ProjectName = ws.UsedRange.Find("Project Name:", MatchCase:=True)
            Set StoreName = ws.UsedRange.Find("Store Name:", MatchCase:=True)

            Do
             
                'Cost Code
                Worksheets("Vendor DATA").Cells(i, 1).Value = Cost_Code
                'Vendor Name
                Worksheets("Vendor DATA").Cells(i, 2).Value = Cost_Code.Offset(, -9)
                'Standard Contract Name
                Worksheets("Vendor DATA").Cells(i, 3).Value = Cost_Code.Offset(, -6)
                'Standard Contract Amount
                Worksheets("Vendor DATA").Cells(i, 4).Value = Cost_Code.Offset(, 2)
                'Approved Change Orders
                Worksheets("Vendor DATA").Cells(i, 5).Value = Cost_Code.Offset(, 5)
                'Total Committed
                Worksheets("Vendor DATA").Cells(i, 6).Value = Cost_Code.Offset(, 7)
                'Date
                Worksheets("Vendor DATA").Cells(i, 7).Value = Cost_Code.Offset(, -4)
                'Invoiced
                Worksheets("Vendor DATA").Cells(i, 8).Value = Cost_Code.Offset(, 10)
                'Balance Remaining
                Worksheets("Vendor DATA").Cells(i, 9).Value = Cost_Code.Offset(, 11)
                'Project Name
                Worksheets("Vendor DATA").Cells(i, 10).Value = ProjectName.Offset(, 1)
                'Store Name
                Worksheets("Vendor DATA").Cells(i, 11).Value = StoreName.Offset(, 1)
                
                Set Cost_Code = Worksheets(wsName).Range(ReFCell_CostCode_ColAddress).FindNext(Cost_Code)
                
                i = i + 1

            Loop While ReFCell_FirstCell_Address <> Cost_Code.Address

        End If
NextWorksheet:

    Next ws

字符串
错误弹出并指向这行代码


的数据
我期望循环所有的cost_code变量,并且cost_code变量将始终在定义的列范围内的每个工作表中找到所有非空单元格。
数据集很好。我从一个工作表开始,代码运行得很好。例如
代码:
第一个月
但是当我用一个代表工作表名称的变量替换特定的工作表时,

qvtsj1bj

qvtsj1bj1#

我建议跳过Find()--它只会增加复杂性。在列上进行简单的循环会更容易:

Sub Tester()

    Dim ws As Worksheet
    Dim Cost_Code As Range, ProjectName As Range, StoreName As Range
    Dim i As Long, ccHdr As Range, c As Range

    i = 2
    'Looping Each Worksheet and Check Whether They Are Project Tabs
    For Each ws In ThisWorkbook.Worksheets
    
        If ws.Name Like "#*" Then 'Check tab name begins with a digit
            'note not checking each of these calls to Find succeeds...
            Set ProjectName = ws.UsedRange.Find("Project Name:", lookat:=xlWhole, MatchCase:=True)
            Set StoreName = ws.UsedRange.Find("Store Name:", lookat:=xlWhole, MatchCase:=True)
            Set ccHdr = ws.UsedRange.Find("Cost Code", lookat:=xlWhole, MatchCase:=True)
            
            For Each c In ws.Range(ccHdr.Offset(1), _
                              ws.Cells(Rows.Count, ccHdr.Column).End(xlUp)).Cells
                If Len(c.Value) > 0 Then 'has a value ?
                    With ThisWorkbook.Worksheets("Vendor DATA").Rows(i)
                        .Cells(1).Value = c.Value              'Cost Code
                        .Cells(2).Value = c.Offset(, -9).Value 'Vendor Name
                        .Cells(3).Value = c.Offset(, -6).Value 'Standard Contract Name
                        'etc etc
                    End With
                    i = i + 1
                End If
            Next c
        End If 'is a worksheet we want
    Next ws
End Sub

字符串

相关问题