如何删除特定单元格，所有包含某字符的行???

jamchen1314

公司有一个表格，是不同的人，在不同时间完成任务情况表格，求一个excel公式，比如A列同一个人“小红”，对应的B列，只要有一个单元格包含“完成”2个字符，那么所有包含小红的行都删除

• 
  

jamchen1314

换句话说，A列名字相同的情况下，只要对应的B列包含“完成”字符，则删除所有包含此名字的行

duquancai

Excel公式？那就去Excel函数板块呗！

media888

用VBA代码


Private Sub CommandButton1_Click()

Dim i%, j%
     i = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To i
    If Sheet1.Range("b" & j) Like "未完成" Then GoTo 100
      
          Sheet1.Range("A" & j & ":b" & j).ClearContents
      
      
100
         Next
End Sub

duquancai

jamchen1314 发表于 2019-9-14 12:49
换句话说，A列名字相同的情况下，只要对应的B列包含“完成”字符，则删除所有包含此名字的行

1. Sub main()
   
2.     Dim arr, resArr(), r&, i&, j&, n&, c As Range, myKeys, myItems, temp
   
3.     Set c = Range("a:a").Find("*", , , , 1, 2)
   
4.     If c Is Nothing Then Exit Sub
   
5.     r = c.Row
   
6.     If r = 1 Then Exit Sub
   
7.     arr = Range("a1:b" & r)
   
8.     Dim d As Object
   
9.     Set d = CreateObject("Scripting.Dictionary")
   
10.     Call get_dic(d, arr)
    
11.     If d.Count = 0 Then Exit Sub
    
12.     ReDim resArr(0 To UBound(arr) - 1, 1 To 2)
    
13.     resArr(0, 1) = arr(1, 1): resArr(0, 2) = arr(1, 2)
    
14.     myKeys = d.keys(): myItems = d.items()
    
15.     For i = 0 To d.Count - 1
    
16.         temp = Split(myItems(i), ";")
    
17.         If UBound(temp) > 0 Then
    
18.             For j = 0 To UBound(temp)
    
19.                 If Not is_complit(temp(j)) Then
    
20.                     n = n + 1
    
21.                     resArr(n, 1) = myKeys(i): resArr(n, 2) = temp(j)
    
22.                 End If
    
23.             Next
    
24.         Else
    
25.             n = n + 1
    
26.             resArr(n, 1) = myKeys(i): resArr(n, 2) = myItems(i)
    
27.         End If
    
28.     Next
    
29.     Range("c1").Resize(n + 1, 2) = resArr '输出区域自己决定！
    
30. End Sub
    
31. Sub get_dic(ByRef d As Object, ByVal arr)
    
32.     Dim i&
    
33.     For i = 2 To UBound(arr)
    
34.         If Len(arr(i, 1)) Then
    
35.             If Not d.exists(arr(i, 1)) Then
    
36.                 d(arr(i, 1)) = arr(i, 2)
    
37.             Else
    
38.                 d(arr(i, 1)) = d(arr(i, 1)) + ";" + arr(i, 2)
    
39.             End If
    
40.         End If
    
41.     Next
    
42. End Sub
    
43. Function is_complit(ByVal s As String) As Boolean
    
44.     Dim re As Object
    
45.     Set re = CreateObject("VBScript.Regexp")
    
46.     re.Pattern = "日完成"
    
47.     is_complit = re.test(s)
    
48. End Function

复制代码

yylucke

duquancai 发表于 2019-9-14 14:49

能否给个正则使用的链接教程，谢谢！

ggmmlol

筛选未完成.rar (7 KB, 下载次数: 3)

2019-9-14 16:57 上传

点击文件名下载附件