EXCEL信息汇总

wantosay

ykcbf1100 发表于 2022-12-20 08:47
你这活没办法干，你只上传了部门的数据，但你汇总表的样式是怎样的？别人不知道啊。汇总表如果和部门一样 ...

各部门填各自负责的内容，表格格式相同，将各部门所填数据汇总一张表中，不需要对数据本身作处理，只要copy过来即可。

ykcbf1100

wantosay 发表于 2022-12-20 09:40
各部门填各自负责的内容，表格格式相同，将各部门所填数据汇总一张表中，不需要对数据本身作处理，只要co ...

就copy一个日期？

gwjkkkkk

wantosay 发表于 2022-12-19 17:50
附件中有表，就是把各部门反馈的表中第C D列数据汇总到一块，各部门数据不重复，也不用考虑空值单元格， ...

拷贝数据就在c、d列还是其他地方数据也要拷贝。

gwjkkkkk

看到了，应该是C7:D38的数据。

wantosay

gwjkkkkk 发表于 2022-12-20 10:57
看到了，应该是C7:D38的数据。

是的，就这两列C7:D38数据copy到一张表中即可（各部门的数据范围不一样，如有的C7：D10，有的是C12:D15,）。不用考虑这两列数据本身的属性，无论是文字也好，数字或且日期也罢，只是将各部门提供的信息挪到到一张表中，各部门使用的模板格式是相同的。

ykcbf1100

wantosay 发表于 2022-12-20 11:57
是的，就这两列C7:D38数据copy到一张表中即可（各部门的数据范围不一样，如有的C7：D10，有的是C12:D15, ...

应该没有想象的那么简单，你客户满意度和按时完成情况二个区域分开copy吧。实际上，必要时得插入一些行。而且，你不能单独复制CD二列吧，AB列相应内容要一并复制进去，不然，那些数据就会错位。

fzxba

1. Sub test1() '。
   
2.   Dim Conn As Object, Dict As Object, strConn As String
   
3.   Dim p As String, f As String, s As String, SQL As String
   
4.   Set Dict = CreateObject("Scripting.Dictionary")
   
5.   Set Conn = CreateObject("ADODB.Connection")
   
6.   s = "Excel 12.0;HDR=no;Database="
   
7.   If Application.Version < 12 Then
   
8.     s = Replace(s, "12.0", "8.0")
   
9.     strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=no';Data Source="
   
10.   Else
    
11.     strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=no';Data Source="
    
12.   End If
    
13.   Conn.Open strConn & ThisWorkbook.FullName
    
14.   p = ThisWorkbook.Path & "\"
    
15.   f = Dir(p & "*.xls?")
    
16.   SQL = "SELECT * FROM [" & s & p & "[f]].[Standard$A7:D38] WHERE LEN(F3)"
    
17.   Do
    
18.     If p & f <> ThisWorkbook.FullName Then
    
19.       Dict.Add Replace(SQL, "[f]", f), vbNullString
    
20.     End If
    
21.     f = Dir
    
22.   Loop While Len(f)
    
23.   If Dict.Count Then
    
24.     SQL = Join(Dict.Keys, " UNION ALL ")
    
25.     SQL = "SELECT a.*,b.F3,b.F4 FROM [Standard$A7:B38] a LEFT JOIN (" & SQL & ") b ON a.F1=b.F1"
    
26.     Range("A7").CopyFromRecordset Conn.Execute(SQL)
    
27.   End If
    
28.   Conn.Close
    
29.   Set Conn = Nothing
    
30.   Set Dict = Nothing
    
31.   Beep
    
32. End Sub

复制代码

wantosay

ykcbf1100 发表于 2022-12-20 14:50
应该没有想象的那么简单，你客户满意度和按时完成情况二个区域分开copy吧。实际上，必要时得插入一些行。 ...

其实，是否可以这样考虑，，先对所打开的表的C7:D38中查下是否有非空单元格，且确认好非空单元格开始行（如N）及末行数(如M)，这样直接将这个区域(C[N]:D[M+1])内容copy过来。我觉得逻辑是这样，代码我不会

wantosay

fzxba 发表于 2022-12-20 16:15

谢谢，我来调试下

gwjkkkkk

wantosay 发表于 2022-12-20 11:57
是的，就这两列C7:D38数据copy到一张表中即可（各部门的数据范围不一样，如有的C7：D10，有的是C12:D15, ...

请楼主参考附件，请解压后使用。。。