Chuyển dữ liệu chấm công

[quangtung1510]

Xin chào mọi người,
Hiện tại, em có một file dữ liệu chấm công Sheet 1 xuất ra từ phần mềm, mọi người có cách nào để thành dữ liệu như Sheet 2 được không ạ.
( Dữ liệu quẹt mốc của một ngày thay vì thể hiện từng ô riêng trên 1 cột, sẽ thể hiện trên 1 dòng và theo thứ tự cột).
Cảm ơn mọi người nhiều.

 

[Lê Hồng Minh83]

Xin chào mọi người,
Hiện tại, em có một file dữ liệu chấm công Sheet 1 xuất ra từ phần mềm, mọi người có cách nào để thành dữ liệu như Sheet 2 được không ạ.
( Dữ liệu quẹt mốc của một ngày thay vì thể hiện từng ô riêng trên 1 cột, sẽ thể hiện trên 1 dòng và theo thứ tự cột).
Cảm ơn mọi người nhiều.

Như này phải không nhỉ

=IFERROR(AGGREGATE(15,6,(Sheet1!$E$6:$E$30)/(Sheet1!$A$6:$A$30=$A6)/(Sheet1!$B$6:$B$30=$B6),COLUMN(A1)),"")

 

[snow25]

Xin chào mọi người,
Hiện tại, em có một file dữ liệu chấm công Sheet 1 xuất ra từ phần mềm, mọi người có cách nào để thành dữ liệu như Sheet 2 được không ạ.
( Dữ liệu quẹt mốc của một ngày thay vì thể hiện từng ô riêng trên 1 cột, sẽ thể hiện trên 1 dòng và theo thứ tự cột).
Cảm ơn mọi người nhiều.

Đây bạn xem

Sub chuyendulieu()
Dim arr, arr1
Dim dic As Object
Dim a As Long, b As Long, c As Long, d As Long, i As Long, j As Long
Dim dk As String
Set dic = CreateObject("scripting.dictionary")
With Sheet1
    arr = .Range("A6:e" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    ReDim arr1(1 To UBound(arr, 1), 1 To UBound(arr, 1) + 7)
    For i = 1 To UBound(arr, 1)
        dk = arr(i, 1) & arr(i, 2)
        If dic.exists(dk) = 0 Then
           a = a + 1
           dic.Item(dk) = Array(a, 7)
           For j = 1 To 4
               arr1(a, j) = arr(i, j)
           Next j
           arr1(a, 5) = arr(i, 1) & " " & arr(i, 5)
           'arr1(a, 6) = "0"
           arr1(a, 7) = arr(i, 5)
        Else
           b = dic.Item(dk)(0)
           c = dic.Item(dk)(1) + 1
           arr1(b, c) = arr(i, 5)
           dic.Item(dk) = Array(b, c)
        End If
    Next i
End With
With Sheet2
     .Range("A16").Resize(10000, 10).ClearContents
    .Range("A16").Resize(a, UBound(arr1, 2)).Value = arr1
End With
End Sub

 

[quangtung1510]

Như này phải không nhỉ

=IFERROR(AGGREGATE(15,6,(Sheet1!$E$6:$E$30)/(Sheet1!$A$6:$A$30=$A6)/(Sheet1!$B$6:$B$30=$B6),COLUMN(A1)),"")

Thank bro

 

[quangtung1510]

Đây bạn xem

Sub chuyendulieu()
Dim arr, arr1
Dim dic As Object
Dim a As Long, b As Long, c As Long, d As Long, i As Long, j As Long
Dim dk As String
Set dic = CreateObject("scripting.dictionary")
With Sheet1
    arr = .Range("A6:e" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    ReDim arr1(1 To UBound(arr, 1), 1 To UBound(arr, 1) + 7)
    For i = 1 To UBound(arr, 1)
        dk = arr(i, 1) & arr(i, 2)
        If dic.exists(dk) = 0 Then
           a = a + 1
           dic.Item(dk) = Array(a, 7)
           For j = 1 To 4
               arr1(a, j) = arr(i, j)
           Next j
           arr1(a, 5) = arr(i, 1) & " " & arr(i, 5)
           'arr1(a, 6) = "0"
           arr1(a, 7) = arr(i, 5)
        Else
           b = dic.Item(dk)(0)
           c = dic.Item(dk)(1) + 1
           arr1(b, c) = arr(i, 5)
           dic.Item(dk) = Array(b, c)
        End If
    Next i
End With
With Sheet2
     .Range("A16").Resize(10000, 10).ClearContents
    .Range("A16").Resize(a, UBound(arr1, 2)).Value = arr1
End With
End Sub

Bài đã được tự động gộp: 30/11/18

Cảm ơn nhiều luôn,
có thể giúp mình thêm 1 tí nữa với, sau khi mình chạy kết quả định dạng thời gian từ ngày 13 trở đi như những ngày trước đó với.

 

[snow25]

Bài đã được tự động gộp: 30/11/18

Cảm ơn nhiều luôn,
có thể giúp mình thêm 1 tí nữa với, sau khi mình chạy kết quả định dạng thời gian từ ngày 13 trở đi như những ngày trước đó với.

Bạn xem mình không biết chỉnh định rạng đâu.

 

[quangtung1510]

Bạn xem mình không biết chỉnh định rạng đâu.

Cảm ơn nhiều nhé

 

[hoangha0578]

Xin chào mọi người,

Hiện tại, em có một file dữ liệu chấm công Sheet 15,17,18, MSNV . mọi người có cách nào để thành dữ liệu như Sheet Data được không ạ.
( Dữ liệu quẹt mốc của một ngày thay vì thể hiện từng ô riêng trên 1 cột, sẽ thể hiện trên 1 dòng và theo thứ tự cột).
Cảm ơn mọi người nhiều.

 

[snow25]

Xin chào mọi người,

Hiện tại, em có một file dữ liệu chấm công Sheet 15,17,18, MSNV . mọi người có cách nào để thành dữ liệu như Sheet Data được không ạ.
( Dữ liệu quẹt mốc của một ngày thay vì thể hiện từng ô riêng trên 1 cột, sẽ thể hiện trên 1 dòng và theo thứ tự cột).
Cảm ơn mọi người nhiều.

Bạn xem code không hiểu sao dài thế nhỉ.

Sub chuyenbangchamcong()
Dim a As Long, b As Long, i As Long, lr As Long, c As Long
Dim arr, arr1(1 To 10000, 1 To 20)
Dim ngaybd As Date, ngaykt As Date, manv As Long, dk As String, dks As String
Dim sh As Worksheet
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
With Sheets("DATA")
     If .Range("D1").Value = Empty Then ngaybd = 1 Else ngaybd = .Range("d1").Value
     If .Range("E1").Value = Empty Then ngaykt = 100000 Else ngaykt = .Range("E1").Value
     manv = .Range("D2").Value
      lr = .Range("B" & Rows.Count).End(xlUp).Row
      If lr > 5 Then .Range("A6:l" & lr).ClearContents
End With
   dk = "#15#17#18#"
For Each sh In ThisWorkbook.Worksheets
    If InStr(dk, "#" & sh.Name & "#") Then
       lr = sh.Range("B" & Rows.Count).End(xlUp).Row
       If lr > 2 Then
          arr = sh.Range("A3:C" & lr).Value
          For i = 1 To UBound(arr, 1)
              If CLng(arr(i, 2)) >= CLng(ngaybd) And CLng(arr(i, 2)) <= CLng(ngaykt) Then
                 dks = arr(i, 1) & "#" & arr(i, 2)
                 If manv = Empty Then
                    If Not dic.exists(dks) Then
                       a = a + 1
                       arr1(a, 1) = arr(i, 1)
                       arr1(a, 2) = arr(i, 2)
                       arr1(a, 3) = doingay(arr(i, 2))
                       arr1(a, 5) = arr(i, 3)
                       dic.Item(dks) = Array(a, 5)
                    Else
                       b = dic.Item(dks)(0)
                       c = dic.Item(dks)(1) + 1
                       arr1(b, c) = arr(i, 3)
                       dic.Item(dks) = Array(b, c)
                    End If
                 ElseIf CStr(manv) = CStr(arr(i, 1)) Then
                    If Not dic.exists(dks) Then
                       a = a + 1
                       arr1(a, 1) = arr(i, 1)
                       arr1(a, 2) = arr(i, 2)
                       arr1(a, 3) = doingay(arr(i, 2))
                       arr1(a, 5) = arr(i, 3)
                       dic.Item(dks) = Array(a, 5)
                    Else
                       b = dic.Item(dks)(0)
                       c = dic.Item(dks)(1) + 1
                       arr1(b, c) = arr(i, 3)
                       dic.Item(dks) = Array(b, c)
                    End If
                 End If
              End If
        Next i
    End If
  End If
Next
With Sheets("Msnv")
    lr = .Range("B" & Rows.Count).End(xlUp).Row
       If lr > 2 Then
          arr = .Range("A3:C" & lr).Value
          For i = 1 To UBound(arr, 1)
                 dic.Add arr(i, 1), arr(i, 2)
          Next i
       End If
          If a Then
             For i = 1 To a
                 If dic.exists(arr1(i, 1)) Then
                    arr1(i, 4) = dic.Item(arr1(i, 1))
                 End If
             Next i
          Else
             MsgBox "khong tim thay gi"
             Exit Sub
          End If
End With
With Sheets("DATA")
     .Range("A6").Resize(a, 12).Value = arr1
End With
End Sub
Function doingay(ByVal ngay As Long)
    Dim thu As String, a As Integer
    a = ngay Mod 7
    If a = 1 Then
    doingay = "CN"
    ElseIf a = 0 Then
    doingay = "T7"
    Else
    doingay = "T" & a
    End If
End Function

 

[hoangha0578]

Cám ơn bạn nhiều.