需要查找的内容有5条，如果某行出现其中的2条，就把该行染成绿色

wwdfefgg · 发表于 2019-4-20 19:01

从第2行到下面有很多数据，各种格式的，有文本有数字，长度也不一样，没任何规律。。

需要查找的内容有5条，在第一行已经列了出来，，，如果某行出现要查找的内容中的2条，就把该行染成绿色。

查找.rar (30.77 KB, 下载次数: 9)

liulang0808 · 发表于 2019-4-20 20:39

Sub 按钮1_Click()
Application.ScreenUpdating = False
Set Rng = Nothing
arr = Range([c1], Cells(1, Columns.Count).End(xlToLeft))
For j = 2 To ActiveSheet.UsedRange.Rows.Count
a = 0
For i = 1 To UBound(arr, 2)
If Not Rows(j).Find(arr(1, i), lookat:=xlWhole) Is Nothing Then
a = a + 1
If a = 2 Then
If Rng Is Nothing Then
Set Rng = Rows(j)
Else
Set Rng = Union(Rows(j), Rng)
End If
Exit For
End If
End If
Next i
Next j
If Not Rng Is Nothing Then Rng.Interior.ColorIndex = 6
Application.ScreenUpdating = True
End Sub

复制代码

liulang0808 · 发表于 2019-4-20 20:40

本帖最后由 liulang0808 于 2019-4-20 20:42 编辑

附件内容供参考。。。。

719404338 · 发表于 2019-4-20 20:56

Sub t()
Dim i, j, k, x, arr
arr = [c1:g1]
For i = 13 To [a65536].End(3).Row
x = 0
For j = 1 To 54
For k = 1 To UBound(arr, 2)
If Cells(i, j) = arr(1, k) Then
x = x + 1
End If
Next k
Next j
If x >= 2 Then
Rows(i).Interior.ColorIndex = 10
End If
Next i
End Sub

复制代码

kzg2013 · 发表于 2019-4-20 21:31

Sub aa()
Dim r%, k%, kk%, m%
Dim d As Object
r = UsedRange.Rows.Count
ar = Range("c1:g1")
Cells.Font.Size = 9
Cells.Interior.ColorIndex = 0
For k = 2 To r
   c = Cells(k, Columns.Count).End(xlToLeft).Column
   If c > 1 Then
   Rng = Range(Cells(k, 1), Cells(k, c))
         Set d = CreateObject("scripting.dictionary")
            For m = 1 To UBound(Rng, 2)
                  For kk = 1 To UBound(ar, 2)
                     If Rng(1, m) = ar(1, kk) Then
                           d(ar(1, kk)) = ""
                           With Cells(k, m)
                           .Font.Size = 35
                           End With
                           Exit For
                     End If
                  Next kk
            Next m
         If d.Count = 2 Then'如果二条以上可改成D.COUNT>=2
            Rows(k).Interior.Color = RGB(0, 255, 0)
            d.RemoveAll
         End If
   End If
   Next k
   Set d = Nothing
End Sub

wwdfefgg · 发表于 2019-4-21 18:48

liulang0808 发表于 2019-4-20 20:40
附件内容供参考。。。。

如何把某行出现的个数写在A列
就是说如果某行出现5条里面是2条，就在A列些2；
如果某行出现5条里面是3条，就在A列些3；

wwdfefgg · 发表于 2019-4-21 18:49

增加一个辅助A列

liulang0808 · 发表于 2019-4-21 19:17

wwdfefgg 发表于 2019-4-21 18:49
增加一个辅助A列

Sub 按钮1_Click()
Application.ScreenUpdating = False
Set Rng = Nothing
arr = Range([c1], Cells(1, Columns.Count).End(xlToLeft))
For j = 2 To ActiveSheet.UsedRange.Rows.Count
a = 0
For i = 1 To UBound(arr, 2)
If Not Rows(j).Find(arr(1, i), lookat:=xlWhole) Is Nothing Then
a = a + 1
End If
Next i
If a >= 2 Then
If Rng Is Nothing Then
Set Rng = Rows(j)
Else
Set Rng = Union(Rows(j), Rng)
End If
Cells(j, 1) = a
End If
Next j
If Not Rng Is Nothing Then Rng.Interior.ColorIndex = 6
Application.ScreenUpdating = True
End Sub

复制代码

代码未测试，楼主自己增加辅助列处理吧

wwdfefgg · 发表于 2019-4-22 01:59

719404338 发表于 2019-4-20 20:56

非常感谢！！！！！！！

wwdfefgg · 发表于 2019-4-22 02:27

各位老师，实在不好意思，还得增加一项功能。

要查找的词很多，我单独做了一个表“要查找的内容”，示例了4行，实际有几百行数据，每行最少1个词，最多5个需要查找的内容。

现在要实现的功能是：统计基础数据表中含有2个或2个以上要查找内容的行的行数。

以第一行（KH048 大大微信姓名 23）为例打个比方，比如基础数据中第10行含有KH048 大大微信 ,,第20行含有姓名 23，其他行要么一个词都没含，或者只含有一个词，，，，，那结果就是2

查找.rar (32.41 KB, 下载次数: 2)

		自动登录	找回密码
密码			免费注册

[求助] 需要查找的内容有5条，如果某行出现其中的2条，就把该行染成绿色

最新热点 /1