如何将recordest 对象中的数据直接写入数组中？

加菲海带

opiona 发表于 2016-6-10 08:34
recordest对象中的数据直接放进一个二维数组中
这个函数的返回值就是一个二维数组啊！
你可以自己转化的 ...

您好，我下载了之前分享的工资表模板，但是我们显示的要求字段更多（16个），改了好几次都不行，您能帮帮我吗？谢谢。在线等

opiona

1. Sub 每个月在一张表()
   
2. 
   
3. 'On Error Resume Next    '// 发生错误，自动执行下一句，就是忽略错误
   
4. Application.ScreenUpdating = False '//关闭屏幕刷新
   
5. Application.DisplayAlerts = False '//关闭系统提示
   
6. t = Timer   '//开始时间
   
7. 
   
8.     StrBT = "姓名,固定工资,绩效工资,独子费,其它,扣款,应发合计,养老保险,医疗保险,失业保险,公积金,缴税工资,代扣个税,其它扣款,扣款合计,实发合计"
   
9. 
   
10.     StrYF = ""
    
11.     StrSQL1 = "" '//汇成总表
    
12.     For I = 1 To 12
    
13.         For Each SH In Worksheets
    
14.             If SH.Name = I & "月" Then
    
15.             If StrYF <> "" Then StrYF = StrYF & ","
    
16.             StrYF = StrYF & Format(I, "00") & "月"
    
17.             
    
18.             If StrSQL1 <> "" Then StrSQL1 = StrSQL1 & " UNION ALL "
    
19.                 StrSQL1 = StrSQL1 & "SELECT " & StrBT
    
20.                 StrSQL1 = StrSQL1 & ",'" & Format(I, "00") & "月' AS 月份"
    
21.                 StrSQL1 = StrSQL1 & " FROM [" & SH.Name & "$A2:P]"
    
22.                 StrSQL1 = StrSQL1 & " WHERE NOT 姓名 IS NULL"
    
23.                
    
24.                 Exit For
    
25.             End If
    
26.         Next
    
27.     Next
    
28. 
    
29.     Str_coon = "HDR=yes';Data Source =" & ThisWorkbook.FullName     '//OFFICE2003，2007 通用
    
30. 
    
31.     StrSQL = "SELECT DISTINCT 姓名 FROM (" & StrSQL1 & ") WHERE LEN(姓名)>0"
    
32.     ARX = GET_SQL_To_Arr(StrSQL, Str_coon, False)  '//不重复姓名放入二维数组
    
33.    
    
34.     BRX = Split(StrYF, ",")
    
35.     For X = 0 To UBound(ARX)   '//循环每一个姓名
    
36.         Set WB = Workbooks.Add
    
37.         
    
38.         For I = 0 To UBound(BRX)
    
39.             StrSQL = "SELECT " & StrBT
    
40.             StrSQL = StrSQL & ",月份 FROM (" & StrSQL1 & ")"
    
41.             StrSQL = StrSQL & " WHERE 姓名='" & ARX(X, 0) & "'"
    
42.             StrSQL = StrSQL & " AND 月份='" & BRX(I) & "'"
    
43.             
    
44.             WB.Worksheets.Add(Before:=WB.Worksheets(1)).Name = BRX(I)
    
45.             Set SHW = WB.Worksheets(BRX(I))
    
46.             SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, True)
    
47.             SHW.Range("A1").Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR
    
48.         Next
    
49. 
    
50.         WB.SaveAs Filename:=ThisWorkbook.Path & "" & ARX(X, 0) & ".XLSX"
    
51.         WB.Close True
    
52.     Next
    
53.    
    
54.    
    
55. Application.ScreenUpdating = True '//恢复屏幕刷新
    
56. Application.DisplayAlerts = True '//恢复系统提示
    
57. MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒", , "北极狐提示!!"  '//提示所用时间
    
58. End Sub

复制代码

opiona

加菲海带 发表于 2018-1-12 12:51
您好，我下载了之前分享的工资表模板，但是我们显示的要求字段更多（16个），改了好几次都不行，您能帮帮 ...

做了2中汇总的
见附件： 工资表.rar (32.17 KB, 下载次数: 12)

2018-1-13 15:58 上传

点击文件名下载附件

加菲海带

opiona 发表于 2018-1-13 15:58
做了2中汇总的
见附件：

谢谢啊
经常看您帮助大家回复问题。