使用宏进行数据筛选输出

jixianbin123

各位大神，如何使用VBA能将sheet1里面的数据按照类型分别输出到安装和维修的表格中，并且在sheet1表格里每输入一行就会自动按照类型输出到安装或者维修的表格中，只需输出单号和日期即可，谢谢各位大神

jixianbin123

自顶一下，新人求助

chaohuahch

常规解法：

1. Sub fyExcelVBA()
   
2. Dim arr, brr, crr, i%, j%
   
3. Dim m%, n%
   
4. arr = Sheets("sheet1").Range("B3").CurrentRegion
   
5. ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) - 1)
   
6. crr = brr
   
7. For i = 2 To UBound(arr)
   
8.      If arr(i, 1) = "安装" Then
   
9.          n = n + 1
   
10.          brr(n, 1) = arr(i, 2)
    
11.          brr(n, 2) = arr(i, 3)
    
12.       Else
    
13.            m = m + 1
    
14.           crr(m, 1) = arr(i, 2)
    
15.           crr(m, 2) = arr(i, 3)
    
16.       End If
    
17. Next i
    
18. Sheets("安装").Range("b3").Resize(UBound(brr), UBound(brr, 2)).ClearContents
    
19. Sheets("安装").Range("b3").Resize(UBound(brr), UBound(brr, 2)) = brr
    
20. Sheets("维修").Range("b3").Resize(UBound(crr), UBound(crr, 2)).ClearContents
    
21. Sheets("维修").Range("b3").Resize(UBound(crr), UBound(crr, 2)) = crr
    
22. 
    
23. 
    
24. End Sub
    

复制代码

chaohuahch

SQL 语法，主要为练习用。速度没有上述代码快：

1. Sub fyExcelVBACon()
   
2. Dim arr, brr, i&, j%, nRow%, nCol%, str$
   
3. Dim cnn, SQL$   '定义数据库连接和SQL语句
   
4. Application.ScreenUpdating = False
   
5. Application.DisplayAlerts = False
   
6. 
   
7. 
   
8. Set cnn = CreateObject("adodb.connection")  '创建数据库连接
   
9. Set rs = CreateObject("adodb.recordset")   '创建一个数据集保存数据
   
10. cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    
11. 
    
12. SQL = "SELECT 单号,日期 FROM [Sheet1$] WHERE 类型='安装'"
    
13. Set rs = cnn.Execute(SQL) '将SQL语句获得的数据传递给数据集
    
14. 
    
15. Sheets("安装").Range("b3").CopyFromRecordset rs
    
16. Set re = Nothing
    
17. SQL = "SELECT 单号,日期 FROM [Sheet1$] WHERE 类型='维修'"
    
18. Set rs = cnn.Execute(SQL) '将SQL语句获得的数据传递给数据集
    
19. Sheets("维修").Range("b3").CopyFromRecordset rs
    
20. rs.Close    '关闭数据集
    
21. cnn.Close     '关闭数据库连接
    
22. Set rs = Nothing
    
23. Set cnn = Nothing    '将CNN从内存中删除。
    
24. Application.ScreenUpdating = True
    
25. Application.DisplayAlerts = True
    
26. 
    
27. End Sub
    
28. 
    
29. 
    

复制代码

jixianbin123

chaohuahch 发表于 2018-8-21 20:27
常规解法：

ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) - 1) 不太明白这一句的意思

chaohuahch

jixianbin123 发表于 2018-8-21 21:35
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) - 1) 不太明白这一句的意思

其实可以生成brr的大小和arr一样。但是你不要前面的安装那一列的数据，所以用了ubound（arr，2）-1

jixianbin123

chaohuahch 发表于 2018-8-21 21:40
其实可以生成brr的大小和arr一样。但是你不要前面的安装那一列的数据，所以用了ubound（arr，2）-1

辛苦了，多谢了

jixianbin123

chaohuahch 发表于 2018-8-21 21:40
其实可以生成brr的大小和arr一样。但是你不要前面的安装那一列的数据，所以用了ubound（arr，2）-1

类似于brr(n, 1) 的类型怎么转化为数值 谢谢了

chaohuahch

jixianbin123 发表于 2018-8-21 23:47
类似于brr(n, 1) 的类型怎么转化为数值 谢谢了

不明白你的意思。brr（n,1）是数组，你说要转化成数值？

jixianbin123

Sub fyExcelVBA()
Dim arr, brr, crr, i%, j%
Dim m%, n%
Dim o, p, r, s As String
arr = Sheets("sheet11").Range("D8").CurrentRegion
ReDim brr(8 To UBound(arr), 1 To UBound(arr))
crr = brr
For i = 8 To UBound(arr)
If arr(i, 4) = "安装" Then
   n = n + 1
   brr(n, 1) = arr(i, 1)
   brr(n, 2) = arr(i, 2)
   brr(n, 5) = arr(i, 3)
   brr(n, 6) = arr(i, 6)
   r = Format(arr(i, 15), "#")
   s = Format(arr(i, 16), "#")
   crr(n, 7) = DateSerial(2018, r, s)


  ElseIf arr(i, 4) = "维修" Then
   m = m + 1
    crr(m, 1) = arr(i, 1)
    crr(m, 2) = arr(i, 2)
    crr(m, 5) = arr(i, 3)
    crr(m, 6) = arr(i, 6)
    r = Format(arr(i, 15), "#")
    s = Format(arr(i, 16), "#")
    crr(n, 7) = DateSerial(2018, r, s)


  End If
  
Next i
Sheets("安装").Range("a4").Resize(UBound(brr), UBound(brr, 2)).ClearContents
Sheets("安装").Range("a4").Resize(UBound(brr), UBound(brr, 2)) = brr
Sheets("维修").Range("a4").Resize(UBound(crr), UBound(crr, 2)).ClearContents
Sheets("维修").Range("a4").Resize(UBound(crr), UBound(crr, 2)) = crr
End Sub
这个代码运行的时候提示下标越界，该如何解决呢