依据"条件区"条件提供相应序号

kandhong88

老师：
   我请教的问题是：依据"条件区"条件提供相应序号。
   思路如下：
   1.红色部分为"序号区"。
   2.蓝色部分为"数据区"。
   实现效果：
   如果"数据区"包含"条件区"中数据，由把它对应的序号去除，再把剩余的序号显示在"结果区"。
   举例说明：
   1.E列中包含数据区数据1，则将1对序号002去掉，现把剩余的001、003、004、005、006、007、008、009、010显示在"结果区"。
   2.G列中包含数据区数据2和4，则将2、4对序号001、005、007去掉，现把剩余的002、003、004、006、007、008显示在'结果区"。
    依据条件提取序号问题.rar (13.08 KB, 下载次数: 5)

2024-3-4 16:21 上传

点击文件名下载附件

   

cidanji

结果在E19效果区.rar (17.99 KB, 下载次数: 3)

2024-3-4 17:19 上传

点击文件名下载附件

kandhong88

cidanji 发表于 2024-3-4 17:19

cidanji老师：
      您的大作已收悉，整体达到了95%效果。但我想更进一步，能否在您目前基础上实现如下效果（数据区不含有数据，序号不显示）。
      1.初期效果
      
      2.最终效果
      
      

cidanji

看懂了，修改.rar (18.18 KB, 下载次数: 3)

2024-3-4 18:06 上传

点击文件名下载附件

kandhong88

cidanji 发表于 2024-3-4 18:07

cidanji老师：
       您提供的VBA大作，强悍无比，再一次感谢您的帮助！！

fzxba

1. Sub test0() '昨日写完就不见原来已解决灌一下吧
   
2.   Dim a, b, c() As String
   
3.   Dim i As Long, j As Long, k As Long, s As String
   
4.   s = Chr(34)
   
5.   a = Range("P2", Range("D2").End(xlDown))
   
6.   b = Range("D12:P15")
   
7.   ReDim c(1 To UBound(a), 1 To UBound(a, 2) - 1)
   
8.   For j = 2 To UBound(b, 2)
   
9.     b(1, j) = s & b(1, j) & s
   
10.     For i = 2 To UBound(b)
    
11.       If Len(b(i, j)) Then b(1, j) = b(1, j) & b(i, j) & s
    
12.     Next
    
13.   Next
    
14.   For j = 2 To UBound(b, 2)
    
15.     If Len(Mid(b(1, j), 3)) Then
    
16.       k = k + 1
    
17.       For i = 1 To UBound(a)
    
18.         If InStr(b(1, j), s & a(i, j) & s) = 0 Then c(i, k) = a(i, 1)
    
19.       Next
    
20.     End If
    
21.   Next
    
22.   With Range("E19")
    
23.     .CurrentRegion.ClearContents
    
24.     .Resize(UBound(c), k) = c
    
25.   End With
    
26. End Sub

复制代码

cidanji

kandhong88 发表于 2024-3-4 18:37
cidanji老师：
       您提供的VBA大作，强悍无比，再一次感谢您的帮助！！

客气了