Mình có 1 cột ngày tháng, và 1 cột dữ liệu các công việc, như trong sheet (Nhatky). mình tham khảo tài liệu và đã gộp được dữ liệu như trong sheet GhiNhatky, nhưng giờ mình muốn gộp các công tác trong ngày lại thành 1 dòng như trong sheet (Yeucau). nhờ các bác chỉ mình sửa đoạn code trong file đính kèm với, Cám ơn nhiều nhiều.
Gộp dữ liệu các dòng bằng VBA
- Thread starter vhtuyen
- Ngày gửi
gộp các công tác trong cùng 1 ngày lại 1 thành 1 dòng thôi, giống như trong sheet Yeucau mình làm ví dụ đó bạn.
Upvote
0
Maika8008
Thành viên gạo cội
- Tham gia
- 12/6/20
- Bài viết
- 4,763
- Được thích
- 5,719
- Donate (Momo)
- Giới tính
- Nam
Bạn bỏ 2 cái sub trong file đi, thay bằng cái này
Rich (BB code):
Sub Ghi_GopNhatky()
Dim sArr, dArr(1 To 65535, 1 To 2)
Dim I As Long, j As Long, K As Long, x As Long, er As Long
Dim Dic As Object, v As Variant
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Nhatky")
sArr = .Range("A4", .Range("A65535").End(3)).Resize(, 2).Value
End With
For I = 1 To UBound(sArr)
If Not Dic.exists(sArr(I, 1)) Then
K = K + 1
Dic.Add sArr(I, 1), K
dArr(K, 1) = sArr(I, 1)
dArr(K, 2) = sArr(I, 2) & vbNewLine
Else
dArr(Dic.Item(sArr(I, 1)), 2) = dArr(Dic.Item(sArr(I, 1)), 2) & sArr(I, 2) & vbNewLine
End If
Next I
With Sheets("GhiNhatky")
er = .Range("B65535").End(3).Row + 1
.Range("A6:B" & er).ClearContents
.Range("A6").Resize(K, 2) = dArr
End With
Set Dic = Nothing
End Sub
Upvote
0
Cám ơn bạn, đã giải đáp vấn đề của mình, đã rất ok. Nhưng cuối mỗi ô gộp nó dư 1 cái xuống dòng, giờ mình phải sửa thế nào.?
Upvote
0
Maika8008
Thành viên gạo cội
- Tham gia
- 12/6/20
- Bài viết
- 4,763
- Được thích
- 5,719
- Donate (Momo)
- Giới tính
- Nam
Để tôi xem thử khử nó đi như thế nào?
Thay bằng:
Rich (BB code):
Sub Ghi_GopNhatky()
Dim sArr, dArr(1 To 65535, 1 To 2)
Dim I As Long, j As Long, K As Long, x As Long, er As Long
Dim Dic As Object, v As Variant
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Nhatky")
sArr = .Range("A4", .Range("A65535").End(3)).Resize(, 2).Value
End With
For I = 1 To UBound(sArr)
If Not Dic.exists(sArr(I, 1)) Then
K = K + 1
Dic.Add sArr(I, 1), K
dArr(K, 1) = sArr(I, 1)
dArr(K, 2) = sArr(I, 2)
Else
dArr(Dic.Item(sArr(I, 1)), 2) = dArr(Dic.Item(sArr(I, 1)), 2) & vbNewLine & sArr(I, 2)
End If
Next I
With Sheets("GhiNhatky")
er = .Range("B65535").End(3).Row + 1
.Range("A6:B" & er).ClearContents
.Range("A6").Resize(K, 2) = dArr
End With
Set Dic = Nothing
End Sub
Upvote
0
Trường hợp nầy bỏ Dic sẽ nhanh gọn hơn
Upvote
0
Nếu dữ liệu trong cột NhatKy!A được sắp xếp như hiện thời thì
Mã:
Sub GopCV()
Dim lastRow As Long, r As Long, curr_row As Long, dulieu()
With ThisWorkbook.Worksheets("GhiNhatky") ' xoa ket qua cu
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
If lastRow >= 6 Then .Range("A6:B" & lastRow).ClearContents
End With
With ThisWorkbook.Worksheets("Nhatky")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
If lastRow < 4 Then Exit Sub ' neu khong co du lieu thi don do choi
dulieu = .Range("A4:B" & lastRow).Value
End With
curr_row = 1
For r = 2 To UBound(dulieu, 1)
If dulieu(r, 1) <> dulieu(r - 1, 1) Then ' chuyen sang ngay moi
curr_row = curr_row + 1
dulieu(curr_row, 1) = dulieu(r, 1)
dulieu(curr_row, 2) = dulieu(r, 2)
Else ' tiep tuc ngay hien thoi
dulieu(curr_row, 2) = dulieu(curr_row, 2) & vbLf & dulieu(r, 2)
End If
Next r
ThisWorkbook.Worksheets("GhiNhatky").Range("A6").Resize(curr_row, 2).Value = dulieu
End Sub
Upvote
0
Maika8008
Thành viên gạo cội
- Tham gia
- 12/6/20
- Bài viết
- 4,763
- Được thích
- 5,719
- Donate (Momo)
- Giới tính
- Nam
Ban đầu tôi cũng muốn bỏ dic vì thấy dữ liệu quá đơn giản, chỉ cần duyệt mảng (như #8) là được. Nhưng nghĩ lại là nếu ngày tháng xếp lung tung mà thớt không muốn sort thì lại phải cần đến dic, do vậy thôi kệ, dùng dao mổ trâu để làm gà cũng được
Upvote
0
"Nhật ký" ghi các sự kiện từng ngày đương nhiên xếp thứ tự theo thời gian với đơn vị là ngàyBan đầu tôi cũng muốn bỏ dic vì thấy dữ liệu quá đơn giản, chỉ cần duyệt mảng (như #8) là được. Nhưng nghĩ lại là nếu ngày tháng xếp lung tung mà thớt không muốn sort thì lại phải cần đến dic, do vậy thôi kệ, dùng dao mổ trâu để làm gà cũng được
Upvote
0
hehe, thanks các bác, dữ liệu đơn giản, nhưng mình mới mày mò cái vụ VBA này, ko có thời đọc bài bản từ đầu, nên dựa theo các ví dụ trên mạng, mà làm theo, làm được vậy cũng dã khá chua và tốn thời gianBan đầu tôi cũng muốn bỏ dic vì thấy dữ liệu quá đơn giản, chỉ cần duyệt mảng (như #8) là được. Nhưng nghĩ lại là nếu ngày tháng xếp lung tung mà thớt không muốn sort thì lại phải cần đến dic, do vậy thôi kệ, dùng dao mổ trâu để làm gà cũng được
. bí quá nên mới hỏi các bác.Sẵn tiện cho hỏi thêm, giờ nếu mình có 2 sheet ghinhatky như trên, ngày tháng khác nhau, giờ muốn gộp 2 sheet lại thành 1, trong sheet mới gồm có 1 cột thời gian được sort, và 2 cột công tác của 2 nội dung khác nhau (như file mình đính kèm), thì mình phải làm sao.
Upvote
0
Maika8008
Thành viên gạo cội
- Tham gia
- 12/6/20
- Bài viết
- 4,763
- Được thích
- 5,719
- Donate (Momo)
- Giới tính
- Nam
Chạy sub Gop2NhatKy trong module sheet GhiNhatKyhehe, thanks các bác, dữ liệu đơn giản, nhưng mình mới mày mò cái vụ VBA này, ko có thời đọc bài bản từ đầu, nên dựa theo các ví dụ trên mạng, mà làm theo, làm được vậy cũng dã khá chua và tốn thời gian
Sẵn tiện cho hỏi thêm, giờ nếu mình có 2 sheet ghinhatky như trên, ngày tháng khác nhau, giờ muốn gộp 2 sheet lại thành 1, trong sheet mới gồm có 1 cột thời gian được sort, và 2 cột công tác của 2 nội dung khác nhau (như file mình đính kèm), thì mình phải làm sao.
Upvote
0
Bài viết mới nhất
- Question
- Question
- Question