查找

star□囧□

想做个按条件查找复制VBA，参考视频老师写的，与目前有点出入。
条件：根据表1(weekly)H10单元格的值在表2(8D list) A列查找，将符合条件部分单元格（包含图片）复制到表1。
来大佬指点下，感谢！

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.6.28
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("weekly")
   
4.         c1 = .UsedRange.Columns.Count
   
5.         st = .[h10].Value
   
6.         For j = 1 To c1
   
7.             s = .Cells(11, j)
   
8.             d(s) = j
   
9.         Next
   
10.     End With
    
11.     ReDim brr(1 To 10000, 1 To 100)
    
12.     With Sheets("8D List")
    
13.         c = .UsedRange.Columns.Count
    
14.         r = .Cells(Rows.Count, 1).End(3).Row
    
15.         arr = .[a1].Resize(r, c)
    
16.         For i = 2 To UBound(arr)
    
17.             If arr(i, 1) = st Then
    
18.                 m = m + 1
    
19.                 For j = 1 To c
    
20.                     s = arr(1, j)
    
21.                     If d.exists(s) Then
    
22.                         brr(m, d(s)) = arr(i, j)
    
23.                     End If
    
24.                 Next
    
25.             End If
    
26.         Next
    
27.     End With
    
28.     With Sheets("weekly")
    
29.         .[a12:j10000] = ""
    
30.         If m > 0 Then
    
31.             .[a12].Resize(m, c1) = brr
    
32.         Else
    
33.             MsgBox "没查到相应记录！"
    
34.         End If
    
35.     End With
    
36.     Set d = Nothing
    
37.     MsgBox "OK！"
    
38. End Sub
    
39. 
    

复制代码

ykcbf1100

楼主的代码是整行复制，但是，表1和表2的标题结构都不同的，肯定不会成功。

star□囧□

ykcbf1100 发表于 2024-6-28 20:00
楼主的代码是整行复制，但是，表1和表2的标题结构都不同的，肯定不会成功。

很感谢，缺少一个条件，图片能否一起复制过来吗

ykcbf1100

star□囧□ 发表于 2024-6-29 19:11
很感谢，缺少一个条件，图片能否一起复制过来吗

图片复制让别人来吧。