VBA字典法——筛选后复制粘贴到另一个表

elon23

要求：用字典法从表a按“是否完成”字段筛选后，复制A、B、D列至表b，大神帮写个代码？谢谢

chxw68

这个用不着字典。

yeminqiang

那需要用字典

elon23

chxw68 发表于 2017-6-29 10:14
这个用不着字典。

数据量大，数据源又有公式，单用复制粘贴效率好慢。

chxw68

1. Sub test1()
   
2.   Dim cnn As New ADODB.Connection
   
3.   Dim rs As New ADODB.Recordset
   
4.   Dim sql As String
   
5.   Dim mybook As String
   
6.   mybook = ThisWorkbook.FullName
   
7.   With cnn
   
8.     If Application.Version = "11.0" Then
   
9.       .Provider = "microsoft.jet.oledb.4.0"
   
10.       .ConnectionString = "extended properties=""excel 8.0;HDR=YES;IMEX=1"";data source=" & mybook
    
11.     Else
    
12.       .Provider = "microsoft.ACE.oledb.12.0"
    
13.       .ConnectionString = "extended properties=""excel 12.0;HDR=YES;IMEX=1"";data source=" & mybook
    
14.     End If
    
15.     .Open
    
16.   End With
    
17.   sql = "select 业务员,产品,销售金额 from [表a$a1:e] where 是否完成='已完成'"
    
18.   rs.Open sql, cnn, adOpenKeyset, adLockOptimistic
    
19.   With Worksheets("表b")
    
20.     .Cells.Delete
    
21.     For j = 0 To rs.Fields.Count - 1
    
22.       .Cells(1, j + 1) = rs.Fields(j).Name
    
23.     Next
    
24.     .Range("a2").CopyFromRecordset rs
    
25.   End With
    
26. End Sub
    

复制代码

chxw68

这样的问题用SQL也很方便。

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   With Worksheets("表a")
   
5.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
6.     arr = .Range("a2:e" & r)
   
7.     ReDim brr(1 To UBound(arr), 1 To 3)
   
8.     m = 0
   
9.     For i = 1 To UBound(arr)
   
10.       If arr(i, 5) = "已完成" Then
    
11.         m = m + 1
    
12.         brr(m, 1) = arr(i, 1)
    
13.         brr(m, 2) = arr(i, 2)
    
14.         brr(m, 3) = arr(i, 4)
    
15.       End If
    
16.     Next
    
17.   End With
    
18.   With Worksheets("表b")
    
19.     .UsedRange.Offset(1, 0).Clear
    
20.     .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
    
21.   End With
    
22. End Sub
    

复制代码

chxw68

数组法的。

elon23

chxw68 发表于 2017-6-29 10:26
数组法的。

数组法掂，谢谢大神，最近麻烦您了！感谢