求VBA跨表检索重复次数与对应项求和

feilv205

寻求帮助解决的问题

文件说明：

两个工作表：

B01中的B1表和BX01中的BX1，B01在F盘，BX01在D盘；

B1、BX1两表中有列标题同为“产品编号”的列，但所在列不同，B1表中在B列，BX1中在C列，在B1表中没有重复，在BX1表中存在重复；

需要帮助解决的：

将B1表B列“产品编号”下各编号在BX1表C列中出现的次数对应计入B1表F列“次数”中，没有出现的为空；对同编号所对应的BX1表中F列的数量进行累加，计入B1表中编号对应的G列“总数”中，没有的计为空格。

论坛里找了字典法、三维数组法、SQL法，在一表中自检捣鼓一下还能对付，跨薄还不同列就汗了，麻烦老师们给予帮助，先谢过！

十分感谢“不知道为什么”、“lsdongjh”两位老师帮助解决问题！
在11楼又对需要汇总的列数据进行了补充，lsdongjh老师在13楼帮助圆满解决。
SQL法结合字典跨表汇总是利器。

不知道为什么

如图

不知道为什么

参考

feilv205

不知道为什么 发表于 2018-9-6 16:08
参考

敲键盘，代码有效，非常感谢老师！

老师，还有个问题：如果BX1表中F列”数量“后的G-K列数据也需要分别求和该怎么修改？

不知道为什么

feilv205 发表于 2018-9-6 17:37
敲键盘，代码有效，非常感谢老师！

老师，还有个问题：如果BX1表中F列”数量“后的G-K列数据也需要分 ...

如果多列需要统计，那建议存放数组

lsdongjh

字典加SQL
字典记录B01中B1表的产品编号所在的行号，
ADO＋SQL　查询ＢＸ０１中BX１的数据，并用GetRows方法转入二维数组
      SELECT  产品编号, Count(产品编号) AS 次数, Sum(数量) AS 总数 FROM [BX1$] GROUP BY 产品编号;

循环读取二维数组，根据编号所在的行，写入相关的内容（此时的二维数组，列对应行）

feilv205

lsdongjh 发表于 2018-9-6 18:04
字典加SQL
字典记录B01中B1表的产品编号所在的行号，
ADO＋SQL　查询ＢＸ０１中BX１的数据，并用GetRows ...

老师，目前我只会依葫芦画瓢，劳驾帮帮忙！

feilv205

不知道为什么 发表于 2018-9-6 17:50
如果多列需要统计，那建议存放数组

只会简单的，这个对我来说真弄不会啊。

feilv205

lsdongjh 发表于 2018-9-6 18:04
字典加SQL
字典记录B01中B1表的产品编号所在的行号，
ADO＋SQL　查询ＢＸ０１中BX１的数据，并用GetRows ...

老师，麻烦指导一下：

Sub BOB() 'SQL法
   Set cnn = CreateObject("ADODB.Connection")
   Set rst = CreateObject("ADODB.Recordset")
   Set wb = Workbooks.Open("d:\BX01.xlsx")
   cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0';data source=" & ThisWorkbook.FullName
   Sql = "select 产品编号,count(*),sum(数量),sum(投料累计数),sum(X1累计废品1),sum(X1累计废品2),sum(X1累计废品3),sum(X1累计成品数量),from[BX1$C1:k] group by 产品编号 "
   rst.Open Sql, cnn, 1, 8
   
   Sheets("B1").[e2].CopyFromRecordset rst
   rst.Close: Set rst = Nothing
   cnn.Close: Set cnn = Nothing
End Sub

lsdongjh

1. Sub Test()
   
2.     Dim shResult As Worksheet
   
3.     Dim arrResult As Variant, arrSource As Variant, lngRow As Long, lngRowID As Long
   
4.     Dim objDic As Object, strKey As String
   
5.     Dim Conn As Object, Rst As Object, strPath As String
   
6.     Dim strConn As String, strSQL As String
   
7. 
   
8.     Set shResult = Sheets("B1")
   
9.     lngRow = shResult.Range("B" & Rows.Count).End(xlUp).Row
   
10.     arrResult = shResult.Range("B1:G" & lngRow)
    
11.    
    
12.     Set objDic = CreateObject("Scripting.Dictionary")
    
13.     For lngRow = 2 To UBound(arrResult)
    
14.         strKey = arrResult(lngRow, 1)
    
15.         If strKey <> "" Then objDic(strKey) = lngRow
    
16.     Next
    
17.    
    
18.     Set Conn = CreateObject("ADODB.Connection")
    
19.     Set Rst = CreateObject("ADODB.Recordset")
    
20.     strPath = "F:\Temp\666\BX01.xlsx" '这是BX01所在的路径及文件名！
    
21.     Select Case Application.Version * 1
    
22.         Case Is <= 11
    
23.             strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & strPath
    
24.         Case Is >= 12
    
25.             strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
26.     End Select
    
27.     Conn.Open strConn
    
28. 
    
29.     strSQL = "SELECT  产品编号, Count(产品编号) AS 次数, Sum(数量) AS 总数 FROM [BX1$] GROUP BY 产品编号;"
    
30.     Rst.Open strSQL, Conn, 3, 1
    
31.     arrSource = Rst.getrows
    
32.    
    
33.     Rst.Close: Set Rst = Nothing
    
34.     Conn.Close: Set Conn = Nothing
    
35.    
    
36.     For lngRow = LBound(arrSource, 2) To UBound(arrSource, 2)
    
37.         strKey = arrSource(0, lngRow)
    
38.         If objDic.Exists(strKey) Then
    
39.             lngRowID = objDic(strKey)
    
40.             arrResult(lngRowID, 5) = arrSource(1, lngRow)
    
41.             arrResult(lngRowID, 6) = arrSource(2, lngRow)
    
42.         End If
    
43.     Next
    
44.    
    
45.     shResult.Range("B1").Resize(UBound(arrResult), UBound(arrResult, 2)) = arrResult
    
46.    
    
47.     MsgBox "OK!"
    
48. End Sub

复制代码