Excel VBA 查找循环以验证最新数据选项卡

Question

我在设置中有一个包含十个度量的列表！$AE:$AE（度量的总数可能会有所不同）并且需要使用 VBA 检查数据中是否存在所有这些度量！$8:$8（作为列标题）使用度量的名称作为唯一标识符。

此宏的目标是检查“数据”选项卡中是否存在度量，如果不存在，则在第 8 行中添加具有相应度量名称的新列。如果度量值在 Settings!$AE:$AE 中不存在并且在 Data!$8:$8 中存在，则应删除相应的列。这将用于维护最新的度量数据表（每一行都是团队成员按日期排列的项目）。

我可以弄清楚插入/删除列，但我需要帮助的是编写一个宏来检查“数据”选项卡与“设置”选项卡。

我四处搜索，发现 .Find 和 .FindNext 循环是解决方案，但我不确定如何将其写为 What:= 值、度量名称、在循​​环的每次迭代中发生变化（设置!$AE:$1，设置！$AE:$2，等等）。

有人能提供 VBA 代码来说明这应该是什么样子吗？谢谢！ =)

Answer 1

DaveU，谢谢。它为我指明了使用 Match 而不是 Find 的正确方向。这解决了我的问题。下面是我的代码。

简而言之，它的作用是在“设置”中计算小节的数量！匹配 Data!，检查该数字是否与 Data 中的度量总数匹配，然后执行相反的操作。如果这两个条件都为真，则MeasuresInDataUpdated 变量设置为真。

我浏览了白板上的逻辑，它似乎消除了正在更新的措施的任何误报。感觉有点过头了，但我认为这是因为工作簿已被锁定，用户很难手动更改某些内容。

Private Function MeasuresInDataUpdated() As Boolean 'Check if the measures in Data match the measures in Settings

Dim MeasuresInSettings As Integer 'Set variable as integer
MeasuresInSettings = WorksheetFunction.CountA(Sheets("Settings").Range("MeasuresNameArea")) 'Set variable to the number of measures in Settings
Dim MeasuresInData As Integer 'Set variable as integer
MeasuresInData = Sheets("Data").Range("MeasuresArea").Columns.Count 'Set variable to the number of measures in Data
Dim MeasuresThatMatchSettings As Integer 'Set variable as integer
MeasuresThatMatchSettings = 0 'Set variable to zero
Dim MeasuresThatMatchData As Integer 'Set variable as integer
MeasuresThatMatchData = 0 'Set variable to zero

Dim MeasuresNamesInSettings As Range 'Set variable as range
Set MeasuresNamesInSettings = Sheets("Settings").Range("MeasuresNames") 'Set variable
Dim MeasuresNamesInData As Range 'Set variable as range
Set MeasuresNamesInData = Sheets("Data").Range("MeasuresNames") 'Set variable
Dim MeasuresName As Range 'Set variable as range

For Each MeasuresName In MeasuresNamesInSettings 'For each measure in Settings
    If Not IsError(Application.Match(MeasuresName, MeasuresNamesInData, 0)) Then 'If measure in Settings is in Data then
        MeasuresThatMatchData = MeasuresThatMatchData + 1 'Set variable to equal itself plus one
    End If
Next MeasuresName

For Each MeasuresName In MeasuresNamesInData 'For each measure in Data
    If Not IsError(Application.Match(MeasuresName, MeasuresNamesInSettings, 0)) Then 'If measure in Data is in Settings then
        MeasuresThatMatchSettings = MeasuresThatMatchSettings + 1 'Set variable to equal itself plus one
    End If
Next MeasuresName

If MeasuresThatMatchData = MeasuresInData And MeasuresThatMatchSettings = MeasuresInSettings Then 'If the measures in Settings that match the measures in Data equal the number of measures in Data, and if the measures in Data that match the measures in Settings equal the number of measures in Settings then
    MeasuresInDataUpdated = True 'Measures in Data are updated
Else
    MeasuresInDataUpdated = False 'Measures in Data are not updated
End If

MsgBox "Measures In Data Updated: " & MeasuresInDataUpdated _
    & vbNewLine & "Measures In Settings: " & MeasuresInSettings _
    & vbNewLine & "Measures That Match Settings: " & MeasuresThatMatchSettings _
    & vbNewLine & "Measures In Data: " & MeasuresInData _
    & vbNewLine & "Measures That Match Data: " & MeasuresThatMatchData

End Function 'End function

Answer 2

看看这是否有帮助。

Sub myColumns()
Dim wS As Worksheet
Dim wT As Worksheet
Dim rS As Range, rT As Range, Cel As Range
Dim l As Long

Application.ScreenUpdating = False

Set wS = ThisWorkbook.Worksheets("Settings")
Set wT = ThisWorkbook.Worksheets("Data")

'source range
With wS
    Set rS = .Range("AE1", .Cells(.Rows.Count, "AE:AE").End(xlUp))
End With

'target range
With wT
    Set rT = .Range("A8", .Cells(8, .Columns.Count).End(xlToLeft))
End With

'add source items to target sheet
For Each Cel In rS
    If IsError(Application.Match(Cel.Value, rT, 0)) Then 'doesn't exist in target, add
    'add to right of existing data
        wT.Cells(8, wT.Columns.Count).End(xlToLeft).Offset(, 1).Value = Cel.Value
    End If
Next Cel

'clear target sheet of source non-matches
For l = rT.Columns.Count To 1 Step -1
     If IsError(Application.Match(rT(l).Value, rS, 0)) Then 'doesn't exist in source, delete
        rT(l).EntireColumn.Delete
    End If
Next l

Application.ScreenUpdating = True

End Sub