请教：指纹考勤机导出的数据（EXCEL格式）如何转换成我需要的格式？提前感谢了！

840205910

有什么不对，通知我（消息）

ahhnyxh

840205910 发表于 2012-7-27 11:16
代码没错，是你的资料中有人一天打卡5、6次，而你原来要求一天最多4次，我代码中设置最多4次，当然异常！
...

我明白了！现在数据完全符合要求了！非常感谢你，漂亮的双胞胎小姑娘！

ahhnyxh

840205910 发表于 2012-7-26 09:41
应该用字典加数组可以做的，回头再来

您好！我又遇到问题了，能麻烦你抽空帮我看看吗？问题发在下面的链接里：
http://club.excelhome.net/thread-901502-1-1.html

ahhnyxh

ahhnyxh 发表于 2012-7-27 12:53
我明白了！现在数据完全符合要求了！非常感谢你，漂亮的双胞胎小姑娘！

代码中好象不是一对一的关系。我测试了一次，打卡10次，我把代码里的数字设到20次都不能正确提出数据，一气之下设为100次，提出的数据才正确。这是什么原因呢？

840205910

把代码里德两个7都改为10就行！只要打卡次数不超过设置的数字就行

mjzxlmg

[code=vb]Sub 转置()
    Dim arr, brr(), i&, j&, k&, m&, n&, d, s$, temp
    Set d = CreateObject("scripting.dictionary")
    With Sheet1
        arr = .Range("A1").CurrentRegion
        ReDim brr(1 To UBound(arr), 1 To 256)
        ReDim temp(1 To UBound(arr))
        For i = 2 To UBound(arr)
            s = arr(i, 1) & arr(i, 2) & arr(i, 3)
            If Not d.exists(s) Then
                m = m + 1
                d(s) = m
                For k = 1 To 4
                    brr(m, k) = arr(i, k)
                Next
            Else
                temp(d(s)) = temp(d(s)) + 1
                brr(d(s), temp(d(s)) + 4) = brr(d(s), temp(d(s)) + 4) & arr(i, 4)
            End If
            If temp(d(s)) > j Then j = temp(d(s))
        Next
        .[g1].CurrentRegion.Offset(1).ClearContents
        .[g2].Resize(m, j + 4).Value = brr
    End With
    Set d = Nothing
End Sub[/code]

840205910

temp(d(s)) = temp(d(s)) + 1'计数作为新数组的列数
brr(d(s), temp(d(s)) + 4) = brr(d(s), temp(d(s)) + 4) & arr(i, 4)

这两句太强悍了

zmemoryr

thinks 太感谢啦

840205910

mjzxlmg 发表于 2012-8-4 09:29

Sub 转置0811()
Dim arr, crr, grr, frr(), drr(), brr(), i&, ir&, k&, n&, j&, x&, y&, d
    Set d = CreateObject("scripting.dictionary")
    arr = Sheet1.UsedRange
    For i = 2 To UBound(arr)
    d(arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)) = d(arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)) & "|" & arr(i, 4)
    Next i
   [g2].Resize(d.Count) = Application.Transpose(d.keys)
   [g2].Resize(d.Count).TextToColumns otherchar:="|", other:=True
   [j2].Resize(d.Count) = Application.Transpose(d.items)
   [j2].Resize(d.Count).TextToColumns otherchar:="|", other:=True
   Application.ScreenUpdating = False
   For j = 2 To [h65536].End(xlUp).Row
    For k = 11 To 17
    If Cells(j, k + 1).Value - Cells(j, k).Value < 0.015 Then
    Cells(j, k + 1).Delete Shift:=xlToLeft
    End If
    If Cells(j, 11).Value > 0.45 Then
    Cells(j, 11).Insert Shift:=xlToRight
    End If
    If Cells(j, 12).Value > 0.65 Then
    Cells(j, 12).Insert Shift:=xlToRight
    End If
    Next
    Next
   Application.ScreenUpdating = True
End Sub

840205910

原始考勤表.zip (49.96 KB, 下载次数: 352)

2012-8-12 14:53 上传

点击文件名下载附件