求助筛选后复制粘贴的问题

scggs

想从工作簿A的sheet1中，筛选掉部门为空的数据
然后复制标注黄色的区域
选择性粘贴到工作薄B中

VBA太深奥了，搞不定了，求助大神，先拜谢。


求助：筛选后选择性粘贴.zip (12.47 KB, 下载次数: 3)

2024-5-7 15:49 上传

点击文件名下载附件

ykcbf1100

代码在B工作簿中。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.5.7
   
2.     Application.ScreenUpdating = False
   
3.     p = ThisWorkbook.Path
   
4.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
5.     f = p & "\工作表A.xlsx"
   
6.     ReDim brr(1 To 10000, 1 To 2)
   
7.     Set wb = Workbooks.Open(f, 0)
   
8.     With wb.Sheets("Sheet1")
   
9.         r = .Cells(Rows.Count, 1).End(3).Row
   
10.         arr = .[a1].Resize(r, 3)
    
11.         For i = 2 To UBound(arr)
    
12.             If Len(arr(i, 2)) Then
    
13.                 m = m + 1
    
14.                 brr(m, 1) = arr(i, 2)
    
15.                 brr(m, 2) = arr(i, 3)
    
16.             End If
    
17.         Next
    
18.         wb.Close False
    
19.     End With
    
20.     With sh
    
21.         .[c3:d10000] = ""
    
22.         With .[c3].Resize(m, 2)
    
23.             .Value = brr
    
24.             .Borders.LineStyle = 1
    
25.             .HorizontalAlignment = xlCenter
    
26.             .VerticalAlignment = xlCenter
    
27.         End With
    
28.     End With
    
29.     Application.ScreenUpdating = True
    
30.     MsgBox "OK！"
    
31. End Sub
    

复制代码

scggs

ykcbf1100 发表于 2024-5-7 17:01
代码在B工作簿中。。。

拜谢大神，明天细细研究下
学了PQ和dax，这两个都是更倾向于查询、汇总、分析的工具，很多时候还是不如VBA批量的方便

ykcbf1100

scggs 发表于 2024-5-7 17:44
拜谢大神，明天细细研究下
学了PQ和dax，这两个都是更倾向于查询、汇总、分析的工具，很多时候还是不如V ...

你这题是最简单的。只用到数组。