统计每月每人加班，原来是竖列想变成横列。

musicalz · 发表于 2014-12-9 19:58

1	装置制造课	包梦新	0
2	装置制造课	包梦新	0
3	装置制造课	包梦新	30.5
4	装置制造课	包梦新	23
5	装置制造课	包梦新	0
6	装置制造课	包梦新	30
7	装置制造课	包梦新	37.5
8	装置制造课	包梦新	45.5
9	装置制造课	包梦新	32.5
10	装置制造课	包梦新	50
11	装置制造课	包梦新	37.5

·
1~11月份个人加班统计（想成为如下的横列）

2014年加班汇总.zip (65.37 KB, 下载次数: 23)

编号	班组	姓名	合计	1	2	3	4	5	6	7	8	9	10	11
1	装置制造课	包梦新	286.5	0	0	30.5	23	0	30	37.5	45.5	32.5	50	37.5

chxw68 · 发表于 2014-12-9 20:08

Sub test()
Dim d As Object
Dim r%, i%
Dim arr, brr()
Set d = CreateObject("scripting.dictionary")
With Worksheets("sheet1")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:d" & r)
mm = Application.Max(Application.Index(arr, 0, 1))
For i = 1 To UBound(arr)
xm = arr(i, 2) & "+" & arr(i, 3)
If Not d.Exists(xm) Then
ReDim brr(1 To mm + 4)
For j = 1 To 3
brr(j) = arr(i, j)
Next
Else
brr = d(xm)
End If
brr(arr(i, 1) + 4) = brr(arr(i, 1) + 4) + arr(i, 4)
brr(4) = brr(4) + arr(i, 4)
d(xm) = brr
Next
End With
With Worksheets("sheet2")
.UsedRange.Offset(1, 0).ClearContents
.Range("a2").Resize(d.Count, UBound(brr)) = Application.Transpose(Application.Transpose(d.Items))
End With
End Sub

复制代码

chxw68 · 发表于 2014-12-9 20:09

参见附件。

zhaogang1960 · 发表于 2014-12-9 20:11

本帖最后由 zhaogang1960 于 2014-12-9 20:46 编辑

字典法请参考：

Sub Macro1()
Dim arr, brr(), d As Object, i&, j&, m&
Set d = CreateObject("scripting.dictionary")
arr = Sheets("Sheet1").Range("A1").CurrentRegion
ReDim brr(1 To UBound(arr), -3 To 11)
For i = 2 To UBound(arr)
s = arr(i, 2) & arr(i, 3)
If Not d.Exists(s) Then
m = m + 1
d(s) = m
brr(m, -3) = m
For j = 2 To 4
brr(m, j - 4) = arr(i, j)
Next
brr(m, arr(i, 1)) = arr(i, 4)
Else
brr(d(s), 0) = brr(d(s), 0) + arr(i, 4)
brr(d(s), arr(i, 1)) = brr(d(s), arr(i, 1)) + arr(i, 4)
End If
Next
With Sheets("Sheet2")
.UsedRange.Offset(1).ClearContents
.[a2].Resize(m, 15) = brr
End With
End Sub

复制代码

zhaogang1960 · 发表于 2014-12-9 20:19

本帖最后由 zhaogang1960 于 2014-12-9 20:39 编辑

4楼代码假设编号最大为11，下面去掉该条件

Sub 编号未知()
Dim arr, brr(), d As Object, i&, j&, m&, c&, s$
Set d = CreateObject("scripting.dictionary")
arr = Sheets("Sheet1").Range("A1").CurrentRegion
c = Application.Max(Sheets("Sheet1").[a:a])
ReDim brr(1 To UBound(arr), -3 To c)
For i = 2 To UBound(arr)
s = arr(i, 2) & arr(i, 3)
If Not d.Exists(s) Then
m = m + 1
d(s) = m
brr(m, -3) = m
For j = 2 To 4
brr(m, j - 4) = arr(i, j)
Next
brr(m, arr(i, 1)) = arr(i, 4)
Else
brr(d(s), 0) = brr(d(s), 0) + arr(i, 4)
brr(d(s), arr(i, 1)) = brr(d(s), arr(i, 1)) + arr(i, 4)
End If
Next
With Sheets("Sheet2")
.Cells.ClearContents
.[a1:d1] = Array("编号", "班组", "姓名", "合计")
.[e1] = 1
.[e1].AutoFill Destination:=.[e1].Resize(, c), Type:=xlFillSeries
.[a2].Resize(m, c + 4) = brr
End With
End Sub

复制代码

zhaogang1960 · 发表于 2014-12-9 20:42

ADO中的TransForm语句也可以实现，请参考：

Sub ADOTransForm()
Dim cnn As Object, rs As Object, i&, SQL$
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
SQL = "TRANSFORM SUM(合计) SELECT null as 编号,班组,姓名,SUM(合计) AS 合计 FROM [Sheet1$] GROUP BY 班组,姓名 PIVOT 编号"
rs.Open SQL, cnn, 1, 3
Cells.ClearContents
For i = 0 To rs.Fields.Count - 1
Cells(1, i + 1) = rs.Fields(i).Name
Next
Range("A2").CopyFromRecordset rs
[a2] = 1
[a2].AutoFill Destination:=[a2].Resize(rs.RecordCount), Type:=xlFillSeries
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

复制代码

张雄友 · 发表于 2014-12-9 21:16

zhaogang1960 发表于 2014-12-9 20:19
4楼代码假设编号最大为11，下面去掉该条件

For j = 2 To 4 是什么意思？摸不透。

zhaogang1960 · 发表于 2014-12-9 21:26

张雄友发表于 2014-12-9 21:16
For j = 2 To 4 是什么意思？摸不透。

第一列写编号到brr的-3列，但是不是原来的编号，而是累计号
从第二列到第四列写入brr-2到0列
brr第1列以后专门用于写合计

zax010 · 发表于 2014-12-10 09:34

Sub zz()
Dim d1, d2, arr, brr
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
arr = Sheet1.Range("A1").CurrentRegion
Sheet2.Range("A2:O1000") = ""
brr = Sheet2.Range("A1:O1000"): m = 1
For i = 2 To UBound(arr)
      d1(arr(i, 2) & "," & arr(i, 3)) = ""
      d2(arr(i, 2) & arr(i, 3) & arr(i, 1)) = arr(i, 4)
Next
For Each k In d1.keys
      m = m + 1: s = Split(k, ","): brr(m, 1) = m - 1: brr(m, 2) = s(0): brr(m, 3) = s(1)
      For j = 5 To UBound(brr, 2)
         brr(m, j) = d2(brr(m, 2) & brr(m, 3) & brr(1, j))
         brr(m, 4) = brr(m, 4) + brr(m, j)
      Next
Next
Sheet2.Range("A1").Resize(m, UBound(brr, 2)) = brr
End Sub

zax010 · 发表于 2014-12-10 09:36

>>>>>>>>>>>>>>>>>>>>>

2014年加班汇总.rar (56.88 KB, 下载次数: 39)

		自动登录	找回密码
密码			免费注册

[求助] 统计每月每人加班，原来是竖列想变成横列。