首页 > 解决方案 > 为什么每次循环都会出现类型不匹配?我不是在声明什么吗?

问题描述

我正在尝试一个 for each 并不断遇到这种类型的不匹配。命名范围是工作簿范围的。

意图:对于“状态”列中的每个单元格,如果 =“非活动”,将“A:AF”复制并粘贴到“非活动”选项卡的下一个空单元格中。

问题代码:

For Each i In Sheet1.ListObjects("CurrentRoster").ListColumns("Status").DataBodyRange
        If Sheet1.ListObjects("CurrentRoster").ListColumns("Status").DataBodyRange.Value = "InActive" 
Then
        Range("A2", Range("AF" & Rows.Count).End(xlUp)).Copy Sheet3.Range("A" & Rows.Count).End(xlUp)(1)
    End If
 Next

这是整个操作。

Sub TableData()

Dim tbl As ListObject
Dim cell As Range
Dim rng As Range
Dim RangeName As String
Dim CellName As String
Dim wb As Workbook, c As Range, m
Dim ws1 As Worksheet
Dim lr As Long
Dim lo As ListObject
Dim i As Range

Worksheets("New Roster").Activate
Range("A1").Select

If Range("A1") = "" Then
     MsgBox "No Data to Reconcile"
     Exit Sub
    Else
 End If

 Application.ScreenUpdating = False  '---->Prevents screen flickering as the code executes.
 Application.DisplayAlerts = False  '---->Prevents warning "pop-ups" from appearing.

' Clears hidden columns
Worksheets("Current Roster").Activate
Range("A1").Activate
Columns.EntireColumn.Hidden = False

On Error Resume Next
Sheet1.ShowAllData
On Error GoTo 0

' Tables the New Roster
Worksheets("New Roster").Activate
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name _
    = "NewRoster"
Range("NewRoster[#All]").Select
ActiveSheet.ListObjects("NewRoster").TableStyle = ""

' Name Ranges for Reference, New Name List From New Roster
ActiveSheet.Range("F2").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Names.Add Name:="NewNameList", RefersToR1C1:= _
    "=NewRoster[Member AHCCCS ID]"
ActiveWorkbook.Names("NewNameList").Comment = "Contains New list to compare old list to"


' Compares CurrentNameList Values to NewNameList Values to verify if current names are still active
Set wb = ThisWorkbook

    For Each c In wb.Names("CurrentNameList").RefersToRange.Cells
        m = Application.Match(c.Value, wb.Names("NewNameList").RefersToRange, 0)
        c.Offset(0, 26).Value = IIf(IsError(m), "InActive", "Active")
    Next c
    
' Move Row with "Inactive" from Current Roster to Inactive Worksheet
 Worksheets("Current Roster").Activate
 
 For Each i In Sheet1.ListObjects("CurrentRoster").ListColumns("Status").DataBodyRange
        If Sheet1.ListObjects("CurrentRoster").ListColumns("Status").DataBodyRange.Value = "InActive" Then
        Range("A2", Range("AF" & Rows.Count).End(xlUp)).Copy Sheet3.Range("A" & Rows.Count).End(xlUp)(1)
    End If
 Next
 
 
 Worksheets("Current Roster").Activate
 On Error Resume Next
 Sheet1.ListObjects("CurrentRoster").DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
 On Error GoTo 0
 Sheet1.ListObjects("CurrentRoster").AutoFilter.ShowAllData
 
' Adds Column to New Roster Table and place Old/New in header cell
 Worksheets("New Roster").Activate
 Worksheets("New Roster").Range("AF1").Value = "Old/New"
 
' Compares CurrentNameList Values to NewNameList Values to determine if New Name, If so, Add to 
Current Roster
    For Each c In wb.Names("NewNameList").RefersToRange.Cells
        m = Application.Match(c.Value, wb.Names("CurrentNameList").RefersToRange, 0)
        c.Offset(0, 26).Value = IIf(IsError(m), "New", "Old")
    Next c
    
' Move Row with "New" from New Roster to Current Roster Worksheet
    Worksheets("New Roster").Activate
    Sheet2.ListObjects("NewRoster").Range.AutoFilter 32, "New"
    Range("A2", Range("AF" & Rows.Count).End(xlUp)).Copy Sheet1.Range("A" & Rows.Count).End(xlUp)(1)

 ' Clear New Roster Data
    Worksheets("New Roster").Activate
    Columns("A:A").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Delete Shift:=xlToLeft
 
 
 

 ActiveWorkbook.Names("NewNameList").Delete
 Worksheets("Current Roster").Activate
 Range("A1").Activate

 ActiveSheet.Range("CurrentRoster[#All]").RemoveDuplicates Columns:=Array(1, 2, _
    3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31 _
    , 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55), _
    Header:=xlYes



 Application.DisplayAlerts = True   '---->Resets the default.
 Application.ScreenUpdating = True  '---->Resets the default.


 End Sub

这里发生了很多事情,并且被拼凑在一起。随意烤。我在尝试学习。

标签: vbafor-loopforeachtype-mismatch

解决方案


推荐阅读