excel vba 判断查找数据

发布网友 发布时间：2022-04-20 02:09

我来回答

共5个回答

热心网友 时间：2023-07-21 17:54

Private Sub CmdAdt_Click() '审核上级产品代码是否存在
Dim kk As Boolean
Dim Totalrows As Integer
Dim ci As Integer, j As Integer, jj As Integer
jj = 0
kk = True
With ActiveSheet
Totalrows = .Cells(65536, 1).End(xlUp).Row
For ci = 3 To Totalrows
If .Cells(ci, 8) = "是" Then
If .Cells(ci, 9) = "" Then '如果没有填上级代码就在H列显示红色
.Cells(ci, 8).Interior.ColorIndex = 3
Else
For j = 3 To Totalrows
If Cells(j, 2) = Cells(ci, 9) Then '只要找到就不用再找了，直接退出for循环
kk = True
jj = j
Exit For
Else
kk = False '找不到，接着找
End If
Next j
If kk = False Then
.Cells(ci, 9).Interior.ColorIndex = 3 '如果上级代码找不到就在H列显示红色
End If
End If
End If
Next ci
End With
End Sub

改成这样了，应该没啥问题了。采纳把

再改一下：
Private Sub CmdAdt_Click() '审核上级产品代码是否存在
Dim kk As Boolean
Dim Totalrows As Integer
Dim ci As Integer, j As Integer, jj As Integer
jj = 0
kk = True
Dim ti As Double
ti = Timer
With ActiveSheet
Totalrows = .Cells(65536, 1).End(xlUp).Row
For ci = 3 To Totalrows
If .Cells(ci, 8) = "是" Then
If .Cells(ci, 9) = "" Then '如果没有填上级代码就在H列显示红色
.Cells(ci, 8).Interior.ColorIndex = 3
jj = jj + 1
Else
For j = 3 To Totalrows
If Cells(j, 2) = Cells(ci, 9) Then '只要找到就不用再找了，直接退出for循环
kk = True
Exit For
Else
kk = False '找不到，接着找
End If
Next j
If kk = False Then
.Cells(ci, 9).Interior.ColorIndex = 3 '如果上级代码找不到就在H列显示红色
jj = jj + 1
End If
End If
ElseIf .Cells(ci, 8) = "" Then
.Cells(ci, 8).Interior.ColorIndex = 3
jj = jj + 1
End If
Next ci
If jj > 0 Then
MsgBox "总共找到" & vbCrLf & jj & vbCrLf & "处错误！耗时" & Timer - ti & "秒！", vbInformation, "提醒"
Else
MsgBox "恭喜没有发现错误！" & vbCrLf & "耗时" & Timer - ti & "秒！", vbInformation, "提醒"
End If
End With
End Sub来自：求助得到的回答

热心网友 时间：2023-07-21 17:55

在E2使用如此公式，然后下拉即可。用VBA如法炮制也可
=IF(C2="是",IF(D2="","请填写上级代码",IF(ISERROR(VLOOKUP(D2,B:B,1,FALSE)),"请检查上级代码是否存在","")),"")

热心网友 时间：2023-07-21 17:55

A B C D
名称 代码 是否是下级 上级代码
蔬菜 10000 否
苹果 20001 是 20000
梨 20003 是 20000
黄瓜 20004 是 20000
水果 20000 否

热心网友 时间：2023-07-21 17:56

Sub a()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim R As Long
R = Range("A65536").End(xlUp).Row
Range("d2:d" & R).Interior.ColorIndex = 0
Dim MyArr
MyArr = Range("a2:d" & R)
Dim i As Long
For i = 1 To UBound(MyArr)
If MyArr(i, 3) = "是" Then
If MyArr(i, 4) = "" Then
Range("d" & i + 1).Interior.ColorIndex = 3 '红色D列无代码
End If
End If
Next i
For i = 1 To UBound(MyArr)
d(MyArr(i, 2)) = ""
Next i
For i = 1 To UBound(MyArr)
If MyArr(i, 4) <> "" Then
If Not d.exists(MyArr(i, 4)) Then
Range("d" & i + 1).Interior.ColorIndex = 6 '*为B列中无代码
End If
End If
Next i
End Sub

热心网友 时间：2023-07-21 17:56

Excel 2016 怎么使用通配符查找数据