vba - 为什么每次循环都会出现类型不匹配?我不是在声明什么吗?
问题描述
我正在尝试一个 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
这里发生了很多事情,并且被拼凑在一起。随意烤。我在尝试学习。
解决方案
推荐阅读
- python - 如何编写复杂的函数来聚合 DataFrame
- visual-studio-code - Bokeh 服务器可以在 VS Code 的 Jupyter 扩展中运行吗?
- python - 来自 API xml 请求的 xml 解析响应
- heroku - 浏览器中的空白页面,控制台中出现意外令牌“<”
- javascript - 设置完全禁用/不可触碰的时间范围
- python - 为什么我在尝试使用 imapclient 时收到 TypeError?
- node.js - 如何将 google gmail api 身份验证从客户端共享到节点服务器
- geoserver - 地理服务器点样式 - 将所有记录中特定字段的值添加到标签中
- python-3.x - 当我单击“运行测试”时,为什么 pytest 会运行完整代码而不是测试?
- python - yfinance:选择一小时间隔时看不到一天中的时间