每个sheet单元格块中的数字

shaorenjun888

统计多个sheet单元格块中没有出现的数字，具体效果见附件。

liulang0808

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Count <> 1 Then Exit Sub
   
3.     If Target.Row <> 31 Then Exit Sub
   
4.     If Len(Target) = 0 Then Exit Sub
   
5.     c = Target.Column
   
6.     Dim arr()
   
7.     ReDim arr(1 To Sheets.Count, 1 To 15)
   
8.     For Each sht In Sheets
   
9.         brr = sht.Cells(31, c).Resize(1, 15)
   
10.         For i = 1 To UBound(brr, 2)
    
11.             arr(sht.Index, i) = brr(1, i)
    
12.         Next i
    
13.     Next sht
    
14.     Cells(16, c).Resize(UBound(arr), UBound(arr, 2)) = arr
    
15. End Sub
    

复制代码

liulang0808

提取所有表，对应右侧15列数据，见附件
其他需求看不大懂，建议楼主结合附件说民吧

shaorenjun888

liulang0808 发表于 2019-6-7 19:59
提取所有表，对应右侧15列数据，见附件
其他需求看不大懂，建议楼主结合附件说民吧

老师，麻烦老师直接看下面楼的附件效果。

shaorenjun888

liulang0808 发表于 2019-6-7 19:59
提取所有表，对应右侧15列数据，见附件
其他需求看不大懂，建议楼主结合附件说民吧

老师，我整理了下，这样现实3个效果。 麻烦老师看下附件：

liulang0808

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Count <> 1 Then Exit Sub
   
3.     If Target.Row <> 31 Then Exit Sub
   
4.     If Len(Target) = 0 Then Exit Sub
   
5.     c = Target.Column
   
6.     Dim arr(), brr()
   
7.     ReDim arr(1 To Sheets.Count, 1 To 15)
   
8.     For Each sht In Sheets
   
9.         crr = sht.Cells(31, c).Resize(1, 15)
   
10.         For i = 1 To UBound(crr, 2)
    
11.             arr(sht.Index, i) = crr(1, i)
    
12.         Next i
    
13.     Next sht
    
14.     Cells(33, c).Resize(UBound(arr), UBound(arr, 2)) = arr
    
15.    
    
16.     ReDim brr(1 To UBound(arr) + 1, 1 To 11)
    
17.     Set d = CreateObject("scripting.dictionary")
    
18.     For i = 0 To 9
    
19.         brr(1, 2 + i) = i
    
20.     Next i
    
21.     brr(1, 1) = ""
    
22.     For j = 1 To UBound(arr)
    
23.         d.RemoveAll
    
24.         For i = 1 To UBound(arr, 2)
    
25.             d(arr(j, i)) = d(arr(j, i)) + 1
    
26.         Next i
    
27.         x = ""
    
28.         For i = 9 To 0 Step -1
    
29.             brr(j + 1, i + 2) = d(i) + 0
    
30.             If d(i) = 0 Then x = x & i
    
31.         Next i
    
32.         brr(j + 1, 1) = x
    
33.     Next j
    
34.     Cells(45, c).Resize(UBound(arr), UBound(brr, 2)) = brr
    
35. End Sub

复制代码

liulang0808

看看这次是否满足需求的。。。。