如何实现筛选复制记录？VBA

may158

筛选条件：1.代码 头2个字符=“85”；2.代码 不等于"850011"；3.摘要 包含"上期"和"生产"

将符合上述条件的记录的数据复制到工作表"台账"

注：工作表"台账"的列位置与工作表"数据库"不是一一对应的。

条件查询.zip (19.01 KB, 下载次数: 15)

2017-4-27 17:10 上传

点击文件名下载附件

lsc900707

台账里的G列对应数据库的哪一列？

Zamyi

包含"上期"或"生产"

1. Sub 宏1()
   
2. Range("V1", [a65536].End(3)).AutoFilter Field:=1, Criteria1:="=85*", Operator:=xlAnd, Criteria2:="<>*0011"
   
3. Range("V1", [a65536].End(3)).AutoFilter Field:=6, Criteria1:="=*上期*", Operator:=xlOr, Criteria2:="=*生产*"
   
4. Range("A5:V13").Copy Sheets("台账").[a2]
   
5. End Sub
   

复制代码

lsc900707

有两列不知对应关系：

1. Sub lsc()
   
2.    Dim brr(1 To 10000, 1 To 7)
   
3.    Arr = Sheet13.UsedRange
   
4.    For I = 2 To UBound(Arr)
   
5.        If Left(Arr(I, 1), 2) = "85" And Arr(I, 1) <> "850011" Then
   
6.            If Arr(I, 6) Like "*上期*" Or Arr(I, 6) Like "*生产*" Then
   
7.                m = m + 1
   
8.                brr(m, 1) = Arr(I, 1): brr(m, 2) = Arr(I, 13): brr(m, 3) = Arr(I, 3)
   
9.                brr(m, 4) = Arr(I, 12): brr(m, 5) = Arr(I, 15): brr(m, 6) = Arr(I, 20)
   
10.                brr(m, 7) = Arr(I, 6)
    
11.            End If
    
12.         End If
    
13.     Next
    
14.     [a2:g10000].ClearContents
    
15.     If m = 0 Then
    
16.         MsgBox "没有相关数据！"
    
17.     Else
    
18.         [a2].Resize(m, 7) = brr
    
19.     End If
    
20. End Sub

复制代码

凌空一羽

1. Sub 凌空一羽()
   
2. Dim cnn As ADODB.Connection
   
3. Set cnn = VBA.CreateObject("ADODB.Connection")
   
4. cnn.Open "provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 12.0;hdr=yes';data source=" & ThisWorkbook.FullName
   
5. Sql = "select 代码,物品名称,`日 期`,null as 完成,`编 码`,单位,null,结存数量,`摘 要` from [数据库$] where 代码  like ""85%"" And 代码 <> ""850011"""
   
6. Sql = "select * from (" & Sql & ")  where `摘 要` like ""生产%"" or `摘 要` like ""上期%"""
   
7. Sheet14.Range("a2").CopyFromRecordset cnn.Execute(Sql)
   
8. cnn.Close
   
9. Set cnn = Nothing
   
10. End Sub

复制代码

lsc900707

如果非要空两列，也可以：

1. Sub lsc()
   
2.    Dim brr(1 To 10000, 1 To 9)
   
3.    Arr = Sheet13.UsedRange
   
4.    For I = 2 To UBound(Arr)
   
5.        If Left(Arr(I, 1), 2) = "85" And Arr(I, 1) <> "850011" Then
   
6.            If Arr(I, 6) Like "*上期*" Or Arr(I, 6) Like "*生产*" Then
   
7.                m = m + 1
   
8.                brr(m, 1) = Arr(I, 1): brr(m, 2) = Arr(I, 13): brr(m, 3) = Arr(I, 3)
   
9.                brr(m, 4) = "": brr(m, 5) = Arr(I, 12): brr(m, 6) = Arr(I, 15)
   
10.                brr(m, 7) = "": brr(m, 8) = Arr(I, 20): brr(m, 9) = Arr(I, 6)
    
11.            End If
    
12.         End If
    
13.     Next
    
14.     [a2:g10000].ClearContents
    
15.     If m = 0 Then
    
16.         MsgBox "没有相关数据！"
    
17.     Else
    
18.         [a2].Resize(m, 9) = brr
    
19.     End If
    
20. End Sub

复制代码

may158

lsc900707 发表于 2017-4-27 17:16
台账里的G列对应数据库的哪一列？

台账里的G列就是空着的

lsc900707

may158 发表于 2017-4-28 09:04
台账里的G列就是空着的

那就用6楼的代码，自己测试效果。

may158

lsc900707 发表于 2017-4-27 22:36
如果非要空两列，也可以：

谢谢！完美解决！