查找数据

风清荷静

要解决的问题是：在“打印”表中从“班别分类”表找到所有人的对应日期的数（如李曼如那样），用编程来做。谢谢大师们了。

ykcbf1100

我看了一下附件，原来二个代码都是我写的。
我等一下写一个吧。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.1.24
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     Set d1 = CreateObject("Scripting.Dictionary")
   
7.     With Sheets("班别分类")
   
8.         r = .Cells(.Rows.Count, "b").End(xlUp).Row
   
9.         arr = .Range("a1:ag" & r)
   
10.     End With
    
11.     For i = 2 To UBound(arr)
    
12.         If arr(i, 1) = Empty Then arr(i, 1) = arr(i - 1, 1)
    
13.         For j = 3 To UBound(arr, 2)
    
14.             s = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(1, j)
    
15.             d(s) = arr(i, j)
    
16.             s = arr(i, 1) & "|" & arr(i, 2)
    
17.             d1(s) = ""
    
18.         Next
    
19.     Next
    
20.     t = d.items
    
21.     ReDim zrr(1 To 10000, 1 To 2)
    
22.     For Each k In d1.keys
    
23.         b = Split(k, "|")
    
24.         m = m + 1
    
25.         zrr(m, 1) = b(0)
    
26.         zrr(m, 2) = b(1)
    
27.     Next
    
28.     With Sheets("打印")
    
29.         .UsedRange.Offset(6) = ""
    
30.         .UsedRange.Offset(6).UnMerge
    
31.         .[a7].Resize(m, 2) = zrr
    
32.         arr = .Range("a6:ag" & m + 5)
    
33.         For i = 2 To UBound(arr)
    
34.             For j = 3 To UBound(arr, 2)
    
35.                 s = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(1, j)
    
36.                 If d.Exists(s) Then
    
37.                     arr(i, j) = d(s)
    
38.                 End If
    
39.             Next
    
40.         Next
    
41.         With .Range("a6:ag" & m + 5)
    
42.             .Value = arr
    
43.             .Borders.LineStyle = 1
    
44.             .HorizontalAlignment = xlCenter
    
45.             .VerticalAlignment = xlCenter
    
46.         End With
    
47.         r = .Cells(Rows.Count, "a").End(xlUp).Row
    
48.         Dim rng As Range
    
49.         For i = r To 7 Step -1
    
50.             Set rng = Cells(i, "a")
    
51.             Set Rng1 = rng.Offset(-1)
    
52.             If rng = Rng1 Then
    
53.                 Rng1.Resize(2).Merge
    
54.             End If
    
55.         Next
    
56.     End With
    
57.     Set d = Nothing
    
58.     Application.ScreenUpdating = True
    
59.     MsgBox "OK！"
    
60. End Sub
    
61. 
    

复制代码

ykcbf1100

附件供参考。。。

风清荷静

ykcbf1100 发表于 2024-1-24 20:01
附件供参考。。。

太完美了，你真是大师，超大师，谢谢，谢谢，万分感谢！

ykcbf1100

风清荷静 发表于 2024-1-25 08:36
太完美了，你真是大师，超大师，谢谢，谢谢，万分感谢！

你过奖了，我就一个VBA爱好者。

风清荷静

ykcbf1100 发表于 2024-1-25 09:49
你过奖了，我就一个VBA爱好者。

大师，打开看一下，在“打印”里取到了“韦报良”的名字，但是8月1、2、3日的数为何不显示呢，只见到“周剑”的数据，再帮看看，谢谢，谢谢了。

ykcbf1100

风清荷静 发表于 2024-1-25 11:27
大师，打开看一下，在“打印”里取到了“韦报良”的名字，但是8月1、2、3日的数为何不显示呢，只见到“周 ...

韦报良下方的空数据造成的，已改。

风清荷静

ykcbf1100 发表于 2024-1-25 11:34
韦报良下方的空数据造成的，已改。

谢谢，谢谢