☰

使用 Excel VBA 如果 a 列中的值不在 b 列中，则将值添加到 c 列

tag-icon • tag-icon microsoft-excel vba macros
使用 Excel VBA 如果 a 列中的值不在 b 列中，则将值添加到 c 列 
Dim i As Variant
    'For i = 1 To 5
     For Each i In rngWatch
     Dim c As Variant
     c = rngWatch.Cells(i, 1).Value
     If i <> rngReconcile.Cells(i, 1).Value Then


        MsgBox i

        End If

        Next i

上面的 for 循环和 if 语句让我困惑。如果某个值rngwatch不在，rngreconcile那么我想将该值添加到新范围（尚未定义）

Sub Client_Dirty_Recon()

Dim Client_path As String
Dim Client_watchlist As Workbook
Dim Client_client_email As Workbook
Set Client_watchlist = ActiveWorkbook
Dim email_range As Range
Dim watchlist_range As Range
Dim wb As Workbook
Dim wbDirty As Workbook

Set wb = ThisWorkbook
Application.ScreenUpdating = False  'optional - screen will not flash

Client_path = Range("Path")
Workbooks.Open Client_path
Dim recon_list As Range
Set wbDirty = Workbooks.Open(Client_path)
Dim rngReconcile As Range
Dim rngWatch As Range
Set rngReconcile = wb.Sheets(1).Range("K:K")
Set rngWatch = wbDirty.Sheets(1).Range("A:A")



Dim i As Variant
    'For i = 1 To 5
     For Each i In rngWatch
     Dim c As Variant
     c = rngWatch.Cells(i, 1).Value
     If i <> rngReconcile.Cells(i, 1).Value Then


        MsgBox i

        End If

        Next i

ActiveWindow.Close Savechanges:=False

End Sub

答案1

根据您的评论，理想情况下您需要两个工作簿，这里是更新的描述和代码：

  1. 这活动工作簿，其命名范围为小路的其他工作簿与手表列表 （西伯利亚）注意：您可以使用 Client_watchlist (ActiveWorkbook) 或 wb (ThisWorkbook)
  2. 同一工作簿有代码模块，其中有调和列表 - 与新值进行比较的现有值（西伯利亚）
  3. 工作簿与手表列表 - 要比较的新值 - 在中指定的位置活动工作簿多于 （陣陣）
  4. 这活动工作簿包含手表不存在的值调和列表。
    • 您不再需要在活动工作簿命名结果路径。
    • 彻底取出编译器变量。
  5. 这活动工作簿必须打开，并且另一个工作簿必须存在，但不是是打开的。当然，您可以进行错误检查，以查看它是否已经打开。
  6. 由于您更改了 ScreenUpdating 属性，我在底部添加了匹配的重置（如果不重置，这会引起很多恐慌！）。还添加了一些状态更新。如果运行速度足够快，可能就没有必要了。

  7. 最后，我使用 Application.WorksheetFunction.Match 函数扫描“Reconcile”列表中的现有值。在我的测试中，该函数的运行速度比循环遍历列表并逐个检查每个值快 7 倍，但这可能因数据类型和值的数量而异。

    Option Explicit

'#Const NewRangeInActiveWorkbook = False

Sub Client_Dirty_Recon()

Dim nRow As Long                        ' Last filled cell in column
Dim c As Range                          ' rngWatch.Cells(i, 1).Value
Dim oldStatusBar As Variant             ' Save StatusBar status
'Dim Client_watchlist As Workbook        ' ActiveWorkbook
Dim Client_path As String               ' Range("Path")
'Dim New_path As String                  ' Range("ResultPath")
Dim wb As Workbook                      ' ThisWorkbook
Dim wbDirty As Workbook                 ' Workbooks.Open(Client_path)
'Dim wbNew As Workbook                   ' Result of compare
Dim rngReconcile As Range               ' wb.Sheets(1).Range("K:K")
Dim rngWatch As Range                   ' wbDirty.Sheets(1).Range("A:A")
Dim rngNew As Range                     ' wbNew.Sheets(1).Range("A:A")

oldStatusBar = Application.DisplayStatusBar     'optional - save StatusBar
Application.DisplayStatusBar = True             'optional - turn on StatusBar
Application.ScreenUpdating = False              'optional - screen won't flash
Application.StatusBar = "Opening workbooks..."  'optional - Update user

'Set Client_watchlist = ActiveWorkbook
'Client_path = Client_watchlist.Names("Path").RefersToRange.Value

Set wb = ThisWorkbook
Client_path = wb.Names("Path").RefersToRange.Value
' Get only used part of column
Set rngReconcile = wb.Sheets(1).Range("K:K")
nRow = rngReconcile(rngReconcile.Cells.Count).End(xlUp).Row   ' Get last filled cell
Set rngReconcile = Range(rngReconcile(1), rngReconcile(nRow)) ' Reduce rng size

Set wbDirty = Workbooks.Open(Client_path)   ' Assumes it exists and is not open
' Get only used part of column
Set rngWatch = wbDirty.Sheets(1).Range("A:A")
nRow = rngWatch(rngWatch.Cells.Count).End(xlUp).Row     ' Get last filled cell
Set rngWatch = Range(rngWatch(1), rngWatch(nRow))       ' Reduce range size

'#If NewRangeInActiveWorkbook Then
'    Set wbNew = Client_watchlist  ' Change #Const above to assign to existing wb
'#Else
'    New_path = Client_watchlist.Names("ResultPath").RefersToRange.Value
'    Set wbNew = Workbooks.Open(New_path) ' Assumes it exists and is not open
'#End If
'Set rngNew = wbNew.Sheets(1).Range("A1") ' Starts in A1; or could put title here
Set rngNew = wb.Sheets(1).Range("A1") ' Starts in A1; or could put title here

For Each c In rngWatch                   ' Each value in rngWatch
    On Error Resume Next                 ' Interrupt Error checking
    If IsError(WorksheetFunction.Match( _
        c.Value, rngReconcile, 0)) Then  ' If not in rngReconcile
        rngNew.FormulaR1C1 = c.Value     ' Copy to rngNew
        Set rngNew = rngNew(2)           ' Moves range down =Offset(rngNew,1,0)
    End If
    On Error GoTo 0                      ' Reset Error checking
    If (c.Row + 1) Mod 100 = 0 Then      'optional - Update user
        Application.StatusBar = "Evaluating cell " & c(2).Address & "..."
    End If
Next c

Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar ' Reset Status Bar
Application.ScreenUpdating = True           ' Very important: turn this back on!

ActiveWindow.Close Savechanges:=False       ' Not sure why this was here, but...

End Sub

答案2

我走了不同的方向......你遇到的问题是代码中的 i 是单元格的值，所以当你将它放入 rngReconcile.Cells(i, 1).Value 调用时，你输入的是文本而不是行号。

您将要遇到的下一个问题是您只检查每一行...我相信您需要一个解决方案来检查 A 列中的每个值与 K 列中的每个值。

我想我已经把它清理得足够干净供你使用了...我确实减少了它，只使用一张纸就可以了，所以如果这是你想要的，我会让你把它放回到多工作簿中...希望你能遵循它。

Dim last_cell As Integer
rngWatch_last_cell = Sheets(1).Range("A65536").End(xlUp).Row
rngReconcile_last_cell = Sheets(1).Range("K65536").End(xlUp).Row


Dim rngWatch_var As Integer, rngReconcile_var As Integer
rngWatch_var = 1
rngReconcile_var = 1

Dim i As Variant
Dim found As Integer

For rngWatch_var = 1 To rngWatch_last_cell
    Dim c As Variant
    c = rngWatch.Cells(rngWatch_var, 1).Value
    found = 0
    For rngReconcile_var = 1 To rngReconcile_last_cell
        If c = rngReconcile.Cells(rngReconcile_var, 1).Value Then
           found = 1
        End If
    Next rngReconcile_var

    If found = 0 Then
        MsgBox c & " not found in list"
        ' add to another column
    End If

Next rngWatch_var

相关内容