Excel 我的循环似乎在填充信息，即使匹配不是'；找不到_Excel_Loops_Vba

Excel 我的循环似乎在填充信息，即使匹配不是'；找不到

excel loops vba

Excel 我的循环似乎在填充信息，即使匹配不是'；找不到,excel,loops,vba,Excel,Loops,Vba,我有下面的循环，我用它在另一张表中查找信息，并填入我正在处理的那张表中。如果找不到值，我希望循环不会更新。然而，它似乎与上面的一行更新，我不明白为什么。非常感谢你的帮助 updrng1是我用于循环的单元格，WorkRng1是我希望更新的当前工作表的范围 WorkRng2是我在WorkRng1中查找的标识符的范围公共变量： Option Explicit Public WorkRng1 As Range Public WorkRng2 As Range Public WorkRng3 As Ra

我有下面的循环，我用它在另一张表中查找信息，并填入我正在处理的那张表中。如果找不到值，我希望循环不会更新。然而，它似乎与上面的一行更新，我不明白为什么。非常感谢你的帮助

updrng1

是我用于循环的单元格，

WorkRng1

是我希望更新的当前工作表的范围

WorkRng2

是我在

WorkRng1

中查找的标识符的范围

公共变量：

Option Explicit
Public WorkRng1 As Range
Public WorkRng2 As Range
Public WorkRng3 As Range
Public Rng1 As Range
Public Rng2 As Range
Public Rng3 As Range
Public blkRow As Range
Public subTskRng As Range
Public UOMRng As Range
Public nmbrRng As Range
Public unitCostRng As Range

这是我的表格代码：

Private Sub CommandButton1_Click()
Dim updRange1 As Range

Set updRange1 = Application.InputBox("Please select all Tasks ID Cells you would like to update", "Title", Type:=8)
Application.ScreenUpdating = False

updRange1.NumberFormat = "@"

Dim matchCounter As Integer
matchCounter = 0

Dim FoundRange As Range
    For Each updrng1 In updRange1
    ''tests task exists in work range 2
    WorkRng2.Parent.Activate
    If updrng1 <> 0 Then
        Set FoundRange = WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If FoundRange Is Nothing Then
            MsgBox "test" & updrng1
        Else
    'updates subtask info
            WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
            If Cells(ActiveCell.Row, subTskRng.Column) <> 0 Then
                Cells(ActiveCell.Row, subTskRng.Column).Copy
            Else
                Cells(ActiveCell.Row, subTskRng.Column - 1).Copy
        End If
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtSubTask.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    'updates UOM info
        WorkRng2.Parent.Activate
        WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, UOMRng.Column).Copy
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtUOM.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    'updates Number of units info
        WorkRng2.Parent.Activate
        WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, nmbrRng.Column).Copy
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtNoUnits.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    'updates Units Cost info
        WorkRng2.Parent.Activate
        WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, unitCostRng.Column).Copy
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtUnitCost.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        If Me.txtBgtTotal.Value <> "" Then
            Cells(ActiveCell.Row, Me.txtBgtTotal.Value).Formula = "=" & Me.txtNoUnits.Value & updrng1.Row & "*" & Me.txtUnitCost.Value & updrng1.Row
        End If
        matchCounter = matchCounter + 1
    End If
    End If
    Next

    updRange1.NumberFormat = "0.0"

Application.ScreenUpdating = True
If matchCounter > 0 Then MsgBox matchCounter & " Tasks Updated!", vbInformation, "Success!"
    'Clear input controls
    Me.txtSubTask.Value = ""
    Me.txtUOM.Value = ""
    Me.txtNoUnits.Value = ""
    Me.txtUnitCost.Value = ""
    Me.txtBgtTotal.Value = ""
    txtSubTask.SetFocus
    Exit Sub
Whoa:
        Select Case Err.Number
            Case 1004
                MsgBox "Check Your Column Letters!", vbInformation, "Oops!"
        End Select

End Sub

Private子命令按钮1\u单击（）
变暗升阻1作为范围
Set updRange1=Application.InputBox（“请选择所有要更新的任务ID单元格”，“标题”，类型：=8）
Application.ScreenUpdating=False
updRange1.NumberFormat=“@”
作为整数的Dim matchCounter
匹配计数器=0
将范围变暗为范围
对于updRange1中的每个updrng1
''测试任务存在于工作范围2中
WorkRng2.Parent.Activate
如果updrng1为0，则
设置FoundRange=WorkRng2.Find（what:=updrng1.Value，LookIn:=xlValues，LookAt:=xlother）
如果FoundRange为空，则
MsgBox“测试”和updrng1
其他的
'更新子任务信息
WorkRng2.Find（what:=updrng1.Value，LookIn:=xlValues，LookAt:=xlWhole）。选择
如果单元格（ActiveCell.Row，subskrng.Column）为0，则
单元格（ActiveCell.Row，subskrng.Column）。复制
其他的
单元格（ActiveCell.Row，subskrng.Column-1）。复制
如果结束
WorkRng1.Parent.Activate
updRange1.Find（what:=updrng1.Value，LookIn:=xlValues，LookAt:=xlWhole）。选择
单元格（ActiveCell.Row、Me.txtSubTask.Value）。选择
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，SkipBlank_
：=假，转置：=假
'更新计量单位信息
WorkRng2.Parent.Activate
WorkRng2.Find（what:=updrng1.Value，LookIn:=xlValues，LookAt:=xlWhole）。选择
单元格（ActiveCell.Row，UOMRng.Column）。复制
WorkRng1.Parent.Activate
updRange1.Find（what:=updrng1.Value，LookIn:=xlValues，LookAt:=xlWhole）。选择
单元格（ActiveCell.Row、Me.txtum.Value）。选择
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，SkipBlank_
：=假，转置：=假
'更新单位数量信息
WorkRng2.Parent.Activate
WorkRng2.Find（what:=updrng1.Value，LookIn:=xlValues，LookAt:=xlWhole）。选择
单元格（ActiveCell.Row，nmbrRng.Column）。复制
WorkRng1.Parent.Activate
updRange1.Find（what:=updrng1.Value，LookIn:=xlValues，LookAt:=xlWhole）。选择
单元格（ActiveCell.Row、Me.txtNoUnits.Value）。选择
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，SkipBlank_
：=假，转置：=假
'更新单位成本信息
WorkRng2.Parent.Activate
WorkRng2.Find（what:=updrng1.Value，LookIn:=xlValues，LookAt:=xlWhole）。选择
单元格（ActiveCell.Row，unitCostRng.Column）。复制
WorkRng1.Parent.Activate
updRange1.Find（what:=updrng1.Value，LookIn:=xlValues，LookAt:=xlWhole）。选择
单元格（ActiveCell.Row，Me.txtnitcost.Value）。选择
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，SkipBlank_
：=假，转置：=假
如果Me.txtbgtottal.Value为“”，则
单元格（ActiveCell.Row，Me.txtbgtottal.Value）。公式=“=”&Me.txtnonoits.Value&updrng1.Row&“*”&Me.txtnitcost.Value&updrng1.Row
如果结束
匹配计数器=匹配计数器+1
如果结束
如果结束
下一个
updRange1.NumberFormat=“0.0”
Application.ScreenUpdating=True
如果matchCounter>0，则MsgBox matchCounter&“任务已更新！”，vbInformation，“成功！”
'清除输入控件
Me.txtSubTask.Value=“”
Me.txtum.Value=“”
Me.txtNoUnits.Value=“”
Me.txtUnitCost.Value=“”
Me.txtbgtottal.Value=“”
txtSubTask.SetFocus
出口接头
哇
选择案例错误编号
案例1004
MsgBox“检查您的列字母！”，vbInformation，“Oops！”
结束选择
端接头

在评论中的每个人的帮助下，我能够使下面的代码正常工作。好处：我甚至添加了一个不匹配错误计数器，它在txtbox中显示数组

以下是我的工作代码：

Private Sub CommandButton1_Click()
Dim updRange1 As Range
Dim list As String
On Error GoTo Whoa
Set updRange1 = Application.InputBox("Please select all Tasks ID Cells you would like to update", "Update Range", Type:=8)
Application.ScreenUpdating = False

updRange1.NumberFormat = "@"

Dim matchCounter As Integer
Dim errorCounter As Integer
matchCounter = 0
errorCounter = 0
Dim FoundRange As Range

    For Each updrng1 In updRange1
    ''tests task exists in work range 2
    WorkRng2.Parent.Activate
    If updrng1 <> 0 And updrng1 <> "Sub Total - Labor Fees" And updrng1 <> "Sub Total - Meetings" And updrng1 <> 21 Then
        Set FoundRange = WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If FoundRange Is Nothing Then
            list = list & updrng1 & ", "
            errorCounter = errrorCounter + 1
        Else
    'updates subtask info
    If Me.txtSubTask.Value <> 0 Then
            WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
            If Cells(ActiveCell.Row, subTskRng.Column) <> 0 Then
                Cells(ActiveCell.Row, subTskRng.Column).Copy
            Else
                Cells(ActiveCell.Row, subTskRng.Column - 1).Copy
            End If
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtSubTask.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
    'updates UOM info
    If Me.txtUOM.Value <> 0 Then
        WorkRng2.Parent.Activate
        WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, UOMRng.Column).Copy
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtUOM.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
    'updates Number of units info
    If Me.txtNoUnits.Value <> 0 Then
        WorkRng2.Parent.Activate
        WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, nmbrRng.Column).Copy
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtNoUnits.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
    'updates Units Cost info
    If Me.txtUnitCost.Value <> 0 Then
        WorkRng2.Parent.Activate
        WorkRng2.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, unitCostRng.Column).Copy
        WorkRng1.Parent.Activate
        updRange1.Find(what:=updrng1.Value, LookIn:=xlValues, LookAt:=xlWhole).Select
        Cells(ActiveCell.Row, Me.txtUnitCost.Value).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
    If Me.txtBgtTotal.Value <> "" Then
        Cells(ActiveCell.Row, Me.txtBgtTotal.Value).Formula = "=" & Me.txtNoUnits.Value & updrng1.Row & "*" & Me.txtUnitCost.Value & updrng1.Row
    End If
        matchCounter = matchCounter + 1
    End If
    End If
    Next

    updRange1.NumberFormat = "0.0"

Application.ScreenUpdating = True
If matchCounter > 0 Then MsgBox matchCounter & " Tasks Updated!", vbInformation, "Success!"
If errorCounter > 0 Then MsgBox "Mismatches: " & list, vbInformation, "Please update the following tasks manually!"
    'Clear input controls
    Me.txtSubTask.Value = ""
    Me.txtUOM.Value = ""
    Me.txtNoUnits.Value = ""
    Me.txtUnitCost.Value = ""
    Me.txtBgtTotal.Value = ""
    txtSubTask.SetFocus
    Exit Sub
Whoa:
        Select Case Err.Number
            Case 1004
                MsgBox "Check Your Column Letters!", vbInformation, "Oops!"
        End Select

End Sub

Private子命令按钮1\u单击（）
变暗升阻1作为范围
将列表变暗为字符串
关于错误转到哇
Set updRange1=Application.InputBox（“请选择所有要更新的任务ID单元格”，“更新范围”，类型：=8）
Application.ScreenUpdating=False
updRange1.NumberFormat=“@”
作为整数的Dim matchCounter
作为整数的Dim errorCounter
匹配计数器=0
errorCounter=0
将范围变暗为范围
对于updRange1中的每个updrng1
''测试任务存在于工作范围2中
WorkRng2.Parent.Activate
如果updrng1 0和updrng1“劳务费小计”和updrng1“会议小计”和updrng1 21
设置FoundRange=WorkRng2.Find（what:=updrng1.Value，LookIn:=xlValues，LookAt:=xlother）
如果FoundRange为空，则
list=list&updrng1&“
errorCounter=errorCounter+1
其他的
'更新子任务信息
如果Me.txtSubTask.Value为0，则
WorkRng2.Find（what:=updrng1.Value，LookIn:=xlValues，LookAt:=xlWhole）。选择
如果单元格（ActiveCell.Row，subskrng.Column）为0，则
单元格（ActiveCell.Row，subskrng.Column）。复制
其他的
单元格（ActiveCell.Row，subskrng.Column-1）。复制
如果结束
WorkRng1.Parent.Activate
updRange1.Find（what:=updrng1.Value，LookIn:=xlValues，LookAt:=xlWhole）。选择
单元格（ActiveCell.Row、Me.txtSubTask.Value）。选择
Selection.Paste特殊粘贴：=xlPasteValues，操作：=xlNone，SkipBlank_
：=假，转置：=假
如果结束
'更新