Gộp 2 dòng dữ liệu.

hoami1020 · 13/8/19

Xin chào anh chị,

Em đang có 1 bảng dữ liệu với 2 dòng trùng nhau như file, em có thể hiện mẫu e mong muốn, nhờ anh chị xem Code giúp em nha.

CHAOQUAY · 14/8/19

hoami1020 đã viết:
Xin chào anh chị,

Em đang có 1 bảng dữ liệu với 2 dòng trùng nhau như file, em có thể hiện mẫu e mong muốn, nhờ anh chị xem Code giúp em nha.

Chạy thử đoạn code bên dưới xem sao

Mã:

Option Explicit
Sub Ghep()
Dim Nguon
Dim Kq
Dim i, j, k, x
k = Sheet1.Range("A1000000").End(xlUp).Row
Nguon = Sheet1.Range("A1", "E" & k)
x = UBound(Nguon, 2)

ReDim Kq(1 To (k + 1) / 2, 1 To x)
For j = 1 To x
    Kq(1, j) = Nguon(1, j)
Next j
For i = 2 To k Step 2
    For j = 1 To x
        Kq(i / 2 + 1, j) = Nguon(i, j)
    Next j
    Kq(i / 2 + 1, x) = Nguon(i + 1, x)
Next i
With Sheet1
    .Range("J1").Resize(UBound(Nguon), UBound(Nguon, 2)).ClearContents
    .Range("J1").Resize(UBound(Kq), UBound(Kq, 2)) = Kq
End With
End Sub

hoami1020 · 14/8/19

Code chạy ok rồi ạ, em xin cảm ơn rất nhiều.

Phuocam · 14/8/19

CHAOQUAY đã viết:

Chạy thử đoạn code bên dưới xem sao

Mã:

Option Explicit
Sub Ghep()
Dim Nguon
Dim Kq
Dim i, j, k, x
k = Sheet1.Range("A1000000").End(xlUp).Row
Nguon = Sheet1.Range("A1", "E" & k)
x = UBound(Nguon, 2)

ReDim Kq(1 To (k + 1) / 2, 1 To x)
For j = 1 To x
    Kq(1, j) = Nguon(1, j)
Next j
For i = 2 To k Step 2
    For j = 1 To x
        Kq(i / 2 + 1, j) = Nguon(i, j)
    Next j
    Kq(i / 2 + 1, x) = Nguon(i + 1, x)
Next i
With Sheet1
    .Range("J1").Resize(UBound(Nguon), UBound(Nguon, 2)).ClearContents
    .Range("J1").Resize(UBound(Kq), UBound(Kq, 2)) = Kq
End With
End Sub

Nhiều For quá, thử dùng 1 vòng For xem sao.

Ba Tê · 14/8/19

phuocam đã viết:
Nhiều For quá, thử dùng 1 vòng For xem sao.

Nếu "ẻm" nào cũng đủ bộ "2 dòng liên tục" thì 1 For:

PHP:

Option Explicit

Public Sub s_Gpe()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long
    sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 5).Value
    R = UBound(sArr)
ReDim dArr(1 To R / 2, 1 To 5)
For I = 1 To R Step 2
    K = K + 1
    dArr(K, 1) = sArr(I, 1)
    dArr(K, 3) = sArr(I, 3)
    dArr(K, 4) = sArr(I, 4)
    dArr(K, 5) = sArr(I + 1, 5)
Next I
Range("J2").Resize(K, 5) = dArr
End Sub

BuiQuangThuan · 14/8/19

Ba Tê đã viết:

Nếu "ẻm" nào cũng đủ bộ "2 dòng liên tục" thì 1 For:

PHP:

Option Explicit

Public Sub s_Gpe()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long
    sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 5).Value
    R = UBound(sArr)
ReDim dArr(1 To R / 2, 1 To 5)
For I = 1 To R [COLOR=rgb(184, 49, 47)][B]Step 2[/B][/COLOR]
    K = K + 1
    dArr(K, 1) = sArr(I, 1)
    dArr(K, 3) = sArr(I, 3)
    dArr(K, 4) = sArr(I, 4)
    dArr(K, 5) = sArr(I + 1, 5)
Next I
Range("J2").Resize(K, 5) = dArr
End Sub

Thầy ơi . Nếu dữ liệu mà nó không lặp lại 2 lần. chẳng hạn có tên thằng nó chỉ xuất hiện 1 lần thì step 2 có vấn đề gì không ạ

Ba Tê · 14/8/19

buiquangthuan đã viết:
Thầy ơi . Nếu dữ liệu mà nó không lặp lại 2 lần. chẳng hạn có tên thằng nó chỉ xuất hiện 1 lần thì step 2 có vấn đề gì không ạ

Kết quả sẽ "tầm bậy tầm bạ".
Lúc đó tính khác, chẳng biết mặt mũi nó ra sao.

BuiQuangThuan · 14/8/19

Ba Tê đã viết:
Kết quả sẽ "tầm bậy tầm bạ".
Lúc đó tính khác, chẳng biết mặt mũi nó ra sao.

Em thử rồi. cả 2 code luôn báo lỗi. Tại em nghĩ. Chẳng hạn công ty có thằng nào làm nhiều quá bị ngơ: vào thì quẹt thẻ mà ra nó quên mất ấy ạ. Chẳng hạn như em ấy ạ

hoami1020 · 14/8/19

Ba Tê đã viết:

Nếu "ẻm" nào cũng đủ bộ "2 dòng liên tục" thì 1 For:

PHP:

Option Explicit

Public Sub s_Gpe()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long
    sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 5).Value
    R = UBound(sArr)
ReDim dArr(1 To R / 2, 1 To 5)
For I = 1 To R Step 2
    K = K + 1
    dArr(K, 1) = sArr(I, 1)
    dArr(K, 3) = sArr(I, 3)
    dArr(K, 4) = sArr(I, 4)
    dArr(K, 5) = sArr(I + 1, 5)
Next I
Range("J2").Resize(K, 5) = dArr
End Sub

Em chào Thầy,
Em xin bổ sung thêm là thông tin không phải lúc nào cũng đẹp như vậy ạ, có người chỉ có 1 giờ vào hoặc ra thôi, lúc đó code lại chạy sai thì e toi luôn ạ.

Ba Tê · 14/8/19

hoami1020 đã viết:
Em chào Thầy,
Em xin bổ sung thêm là thông tin không phải lúc nào cũng đẹp như vậy ạ, có người chỉ có 1 giờ vào hoặc ra thôi, lúc đó code lại chạy sai thì e toi luôn ạ.

Đưa dữ liệu mẫu "đẹp đẽ" thế thì code nó như vậy, nếu nó không "đẹp" thì cũng phải cho ví dụ tất tần tật các loại lu bu có thể xảy ra.
Ví dụ: 2 dòng Vào, 3 dòng Ra, 2 dòng Vào không có dòng Ra, 3 dòng Ra không có dòng Vào, cùng tên nhưng không nằm liên tục v.v...
Làm sao biểu VBA hiểu được "trong bụng" bạn muốn gì khi tiêu đề là "Gộp 2 dòng dữ liệu".
Chuyện này có rất nhiều bài hỏi về tính giờ Vào, Ra bằng "quẹt quẹt"

Phuocam · 14/8/19

hoami1020 đã viết:
Em chào Thầy,
Em xin bổ sung thêm là thông tin không phải lúc nào cũng đẹp như vậy ạ,
có người chỉ có 1 giờ vào hoặc ra thôi, lúc đó code lại chạy sai thì e toi luôn ạ.

Sort theo tên trước khi chạy code:

PHP:

Public Sub GioVao_GioRa()
Dim sArr(), dArr(), i As Long, k As Long, lr As Long
Dim temp As String
    sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 5).Value2
    lr = UBound(sArr)
ReDim dArr(1 To lr, 1 To 5)
For i = 1 To lr
If sArr(i, 1) <> temp Then
    k = k + 1
    dArr(k, 1) = sArr(i, 1)
    dArr(k, 2) = sArr(i, 2)
    dArr(k, 3) = sArr(i, 3)
    temp = sArr(i, 1)
End If
If sArr(i, 4) <> "" Then dArr(k, 4) = sArr(i, 4)
If sArr(i, 5) <> "" Then dArr(k, 5) = sArr(i, 5)
Next i
Range("J2").Resize(k, 5) = dArr
End Sub

BuiQuangThuan · 14/8/19

hoami1020 đã viết:
Em chào Thầy,
Em xin bổ sung thêm là thông tin không phải lúc nào cũng đẹp như vậy ạ, có người chỉ có 1 giờ vào hoặc ra thôi, lúc đó code lại chạy sai thì e toi luôn ạ.

Không biết đúng không. tại đang tập tọe.

Mã:

Sub gpe()
Dim i As Long, arr, dic As Object, dk As String, lR As Long, kq
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
lR = .Range("a65000").End(xlUp).Row
arr = .Range("A2:e" & lR).Value
ReDim kq(1 To UBound(arr), 1 To 5)
    For i = 1 To UBound(arr)
        dk = arr(i, 1)
            If Not dic.exists(dk) Then
            a = a + 1
            dic.Add (dk), a
            kq(a, 1) = arr(i, 1)
            kq(a, 3) = arr(i, 3)
            kq(a, 4) = arr(i, 4)
            kq(a, 5) = arr(i, 5)
            Else
            b = dic.Item(dk)
            kq(b, 4) = kq(b, 4) + arr(i, 4)
            kq(b, 5) = kq(b, 5) + arr(i, 5)
            End If
    Next i
End With
Sheets("sheet1").Range("J2:N65000").ClearContents
Sheets("sheet1").Range("J2:N2").Resize(a).Value = kq
End Sub

Bài đã được tự động gộp: 14/8/19

phuocam đã viết:

Sort theo tên trước khi chạy code:

PHP:

Public Sub GioVao_GioRa()
Dim sArr(), dArr(), i As Long, j As Long, k As Long, lr As Long
Dim temp As String
    sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 5).Value2
    lr = UBound(sArr)
ReDim dArr(1 To lr, 1 To 5)
For i = 1 To lr
If sArr(i, 1) <> temp Then
    k = k + 1
    dArr(k, 1) = sArr(i, 1)
    dArr(k, 2) = sArr(i, 2)
    dArr(k, 3) = sArr(i, 3)
    temp = sArr(i, 1)
End If
If sArr(i, 4) <> "" Then dArr(k, 4) = sArr(i, 4)
If sArr(i, 5) <> "" Then dArr(k, 5) = sArr(i, 5)
Next i
Range("J2").Resize(k, 5) = dArr
End Sub

Đọc bài trên của thầy Ba Tê mới nghĩ ra. Chẳng hạn nó chấm chấm đến 2 lần vào.không có ra. lấy dữ liệu chấm chấm lần thứ hai thì thế nào nhỉ. Mà thôi. Không có dữ liệu thật. em cũng chẳng biết hỏi sao

hoami1020 · 14/8/19

Ba Tê đã viết:
Đưa dữ liệu mẫu "đẹp đẽ" thế thì code nó như vậy, nếu nó không "đẹp" thì cũng phải cho ví dụ tất tần tật các loại lu bu có thể xảy ra.
Ví dụ: 2 dòng Vào, 3 dòng Ra, 2 dòng Vào không có dòng Ra, 3 dòng Ra không có dòng Vào, cùng tên nhưng không nằm liên tục v.v...
Làm sao biểu VBA hiểu được "trong bụng" bạn muốn gì.
Chuyện này có rất nhiều bài hỏi về tính giờ Vào, Ra bằng "quẹt quẹt"

Dạ, do lần đầu nên em hơi lúng túng nên không biết nên ra thế nào, em xin bổ sung lại file chính thức đã liệt kê các trường hợp có thể xảy ra. Nhờ Thầy xem lại giúp em ạ.

BuiQuangThuan · 14/8/19

hoami1020 đã viết:
Dạ, do lần đầu nên em hơi lúng túng nên không biết nên ra thế nào, em xin bổ sung lại file chính thức đã liệt kê các trường hợp có thể xảy ra. Nhờ Thầy xem lại giúp em ạ.

hi vọng đúng ý bạn

Mã:

Sub gpe()
Dim i As Long, arr, dic As Object, dk As String, lR As Long, kq
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
lR = .Range("a65000").End(xlUp).Row
arr = .Range("A2:e" & lR).Value
ReDim kq(1 To UBound(arr), 1 To 5)
    For i = 1 To UBound(arr)
        dk = arr(i, 1)
            If Not dic.exists(dk) Then
            a = a + 1
            dic.Add (dk), a
            kq(a, 1) = arr(i, 1)
            kq(a, 3) = arr(i, 3)
            kq(a, 4) = arr(i, 4)
            kq(a, 5) = arr(i, 5)
            Else
            b = dic.Item(dk)
            kq(b, 4) = kq(b, 4) + arr(i, 4)
            kq(b, 5) = kq(b, 5) + arr(i, 5)
            End If
    Next i
End With
Sheets("sheet1").Range("J2:N65000").ClearContents
Sheets("sheet1").Range("J2:N2").Resize(a).Value = kq
End Sub

hoami1020 · 14/8/19

buiquangthuan đã viết:
Đọc bài trên của thầy Ba Tê mới nghĩ ra. Chẳng hạn nó chấm chấm đến 2 lần vào.không có ra. lấy dữ liệu chấm chấm lần thứ hai thì thế nào nhỉ. Mà thôi. Không có dữ liệu thật. em cũng chẳng biết hỏi sao

Trường hợp nhiều lần vào và nhiều lần ra chủ yếu do em chấm thêm.
Ví dụ: Họ ra 5h nhưng e muốn chấm thêm 3 tiếng nữa cho họ thì e thêm 1 dòng giờ ra nữa là 3 >> Tổng giờ ra là 8. Giờ vào thì lúc đó cũng tương tự cộng dồn như thế ạ ( Đối với vài NV 8h chấm công nhưng 10h họ mới vào làm).

Bài đã được tự động gộp: 14/8/19

buiquangthuan đã viết:

hi vọng đúng ý bạn

Mã:

Sub gpe()
Dim i As Long, arr, dic As Object, dk As String, lR As Long, kq
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
lR = .Range("a65000").End(xlUp).Row
arr = .Range("A2:e" & lR).Value
ReDim kq(1 To UBound(arr), 1 To 5)
    For i = 1 To UBound(arr)
        dk = arr(i, 1)
            If Not dic.exists(dk) Then
            a = a + 1
            dic.Add (dk), a
            kq(a, 1) = arr(i, 1)
            kq(a, 3) = arr(i, 3)
            kq(a, 4) = arr(i, 4)
            kq(a, 5) = arr(i, 5)
            Else
            b = dic.Item(dk)
            kq(b, 4) = kq(b, 4) + arr(i, 4)
            kq(b, 5) = kq(b, 5) + arr(i, 5)
            End If
    Next i
End With
Sheets("sheet1").Range("J2:N65000").ClearContents
Sheets("sheet1").Range("J2:N2").Resize(a).Value = kq
End Sub

Cảm ơn thầy rất nhiều ạ, qua test vài trường hợp thì có vẻ đúng 100% yêu cầu.

BuiQuangThuan · 14/8/19

hoami1020 đã viết:
Trường hợp nhiều lần vào và nhiều lần ra chủ yếu do em chấm thêm.
Ví dụ: Họ ra 5h nhưng e muốn chấm thêm 3 tiếng nữa cho họ thì e thêm 1 dòng giờ ra nữa là 3 >> Tổng giờ ra là 8. Giờ vào thì lúc đó cũng tương tự cộng dồn như thế ạ ( Đối với vài NV 8h chấm công nhưng 10h họ mới vào làm).

Bài đã được tự động gộp: 14/8/19

Cảm ơn thầy rất nhiều ạ, qua test vài trường hợp thì có vẻ đúng 100% yêu cầu.

gọi là bạn được rồi. mình mới có đôi mươi thôi.

Ba Tê · 14/8/19

hoami1020 đã viết:
Trường hợp nhiều lần vào và nhiều lần ra chủ yếu do em chấm thêm.
Ví dụ: Họ ra 5h nhưng e muốn chấm thêm 3 tiếng nữa cho họ thì e thêm 1 dòng giờ ra nữa là 3 >> Tổng giờ ra là 8. Giờ vào thì lúc đó cũng tương tự cộng dồn như thế ạ ( Đối với vài NV 8h chấm công nhưng 10h họ mới vào làm).

Bài đã được tự động gộp: 14/8/19

Cảm ơn thầy rất nhiều ạ, qua test vài trường hợp thì có vẻ đúng 100% yêu cầu.

1/ Máy chấm công của bạn quẹt thế nào mà giờ Vào Ra lại là Number, lại là số chẵn 2, 5, 10 ...? Vào 10 Ra 2 tính sao để ra số giờ công?
2/ Chẳng ai sửa giờ Vào Ra bằng cách cộng thêm như bạn.
Nếu người đó quẹt 8:00:00 mà 10:00:00 mới làm việc thì bạn thêm dòng Vào là 10:00:00 để tính công.
Nói chung dữ liệu quá "vi diệu", khó mà đáp ứng được.

BuiQuangThuan · 14/8/19

Ba Tê đã viết:
1/ Máy chấm công của bạn quẹt thế nào mà giờ Vào Ra lại là Number, lại là số chẵn 2, 5, 10 ...? Vào 10 Ra 2 tính sao để ra số giờ công?
2/ Chẳng ai sửa giờ Vào Ra bằng cách cộng thêm như bạn.
Nếu người đó quẹt 8:00:00 mà 10:00:00 mới làm việc thì bạn thêm dòng Vào là 10:00:00 để tính công.
Nói chung dữ liệu quá "vi diệu", khó mà đáp ứng được.

em cũng thắc mắc nhưng chẳng biết họa mi hót thế nào nữa. chấm công lẽ ra định dạng nó phải ở dạng hh:mm:ss chứ sao lại ra số giờ đẹp thế nhỉ

vu_tuan_manh_linh · 14/8/19

Code chi cho mệt người. Bạn làm thế này nhé:
Bước 1: Quét chọn A1:E1 và filter
Bước 2: Tại E1 đặt công thức =E2
Bước 3: Filter cột D tích bỏ blank
Bước 4: copy công thức tại E2 xuống các dòng còn lại

Gộp 2 dòng dữ liệu.

Thành viên mới

File đính kèm

Thành viên gắn bó

Thành viên mới

Thành viên mới

Cạo Rồi Khỏi Gội

❆❆❆❆❆❆❆❆❆❆❆❆

Cạo Rồi Khỏi Gội

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên mới

Cạo Rồi Khỏi Gội

Thành viên mới

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên mới

File đính kèm

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên mới

❆❆❆❆❆❆❆❆❆❆❆❆

Cạo Rồi Khỏi Gội

❆❆❆❆❆❆❆❆❆❆❆❆

linhvtm84@gmail.com

File đính kèm

Đếm ngược thời gian