Xin giúp đỡ comment tự động theo điều kiện

[huyhoang_mmyeht]

Chào mọi người.
mình có vấn đề comment xin nhờ mọi người giúp đỡ.
tại dữ liệu của mình luôn biến động và số lượng nhiều nên muốn ghi chú lại cho mọi người dể hiểu nhưng mỗi lần thay đổi dữ liệu lại phải comment lại rất mất thời gian nên lên đây nhờ các cao nhân giúp đỡ cách comment tự động theo điều kiện .
file đính kèm có minh họa về comment mong mọi người giúp đỡ.

cảm ơn bạn!

 

[Hoàng Tuấn 868]

nhờ các cao nhân

Bài này đơn giản, mỗi tội chỉ nhờ cao nhân nên chịu khó chờ người khác thôi.

 

[bebo021999]

Không phải cao nhân, thôi cũng liều mạng vậy.
Tên sheet cần phải chuyển qua ký tự không dấu. Mình đã sửa thành "Comment" và "Sum"
Để comment trong vùng cập nhật khi bấm nút "COMMENT", cần có 1 đoạn code, với các hoạt động mô tả như sau:

1) Tại sheet Comment: tạo 1 dictionary với các key là chuỗi ghép code & ngày, item là ghép Qty và Reason .
VD dòng đầu:
key: DJ67-00869D|45113
item: 3|aaa
Vì mình không biết file thực tế của bạn như thế nào, nhưng có thể có trường hợp 1 code phát sinh nhiều lần trong 1 ngày
và comment lúc này cũng cần phải nối nhiều ngày lại. Do đó, item lúc này là ghép dòng 1 và dòng 2. Mình demo dòng 1 & 2 cho giống nhau.
item: 3|aaa@1|bbb
Như vậy ta đã tích hợp được đầy đủ thông tin Comment vào 1 dictionary

2) Tại sheet Sum
- Bỏ hết comment cũ
- duyệt qua từng ô, so sánh code và ngày tương ứng với key của dictionary, nếu thấy thì add vô array, với cột 1 là địa chỉ dòng, cột 2 là địa chỉ cột, cột 3 là comment
- Cuối cùng, loop array lấy địa chỉ ô và add comment vô

Xem file đính kèm nhé.
Đừng bấm nút "COMMENT", nếu không muốn cập nhật.

Option Explicit
Sub sum()
Dim lr&, i&, j&, k&, id As String, com, s, sb
Dim dic As Object, key, res(), arr(1 To 100000, 1 To 3), rng
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Comment")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A2:F" & lr).Value2
End With
For i = 1 To UBound(rng)
    id = rng(i, 2) & "|" & rng(i, 1)
    If Not dic.exists(id) Then
        dic.Add id, rng(i, 5) & "|" & rng(i, 6)
    Else
        dic(id) = dic(id) & "@" & rng(i, 5) & "|" & rng(i, 6)
    End If
Next
Sheets("Sum").Activate
With Range("A2").CurrentRegion
    rng = .Value2
    .ClearComments
End With
For i = 2 To UBound(rng)
    For j = 4 To UBound(rng, 2)
        id = rng(i, 1) & "|" & rng(1, j)
        If dic.exists(id) Then
            k = k + 1: arr(k, 1) = i + 1
            arr(k, 2) = j: arr(k, 3) = dic(id)
        End If
    Next
Next
For i = 1 To k
    com = Split(arr(i, 3), "@"): id = ""
    If UBound(com) = 0 Then
        sb = Split(com(0), "|")
        arr(i, 3) = "Quantity: " & sb(0) & vbLf & "Reason: " & sb(1)
    Else
        For Each sb In com
            s = Split(sb, "|")
            id = id & "Quantity: " & s(0) & ", Reason: " & s(1) & vbLf
        Next
        arr(i, 3) = id
    End If
    Cells(arr(i, 1), arr(i, 2)).AddComment arr(i, 3)
'them . interior.color vao day, neu muon to mau cell
Next
End Sub

 

[huyhoang_mmyeht]

Không phải cao nhân, thôi cũng liều mạng vậy.
Tên sheet cần phải chuyển qua ký tự không dấu. Mình đã sửa thành "Comment" và "Sum"
Để comment trong vùng cập nhật khi bấm nút "COMMENT", cần có 1 đoạn code, với các hoạt động mô tả như sau:

1) Tại sheet Comment: tạo 1 dictionary với các key là chuỗi ghép code & ngày, item là ghép Qty và Reason .
VD dòng đầu:
key: DJ67-00869D|45113
item: 3|aaa
Vì mình không biết file thực tế của bạn như thế nào, nhưng có thể có trường hợp 1 code phát sinh nhiều lần trong 1 ngày
và comment lúc này cũng cần phải nối nhiều ngày lại. Do đó, item lúc này là ghép dòng 1 và dòng 2. Mình demo dòng 1 & 2 cho giống nhau.
item: 3|aaa@1|bbb
Như vậy ta đã tích hợp được đầy đủ thông tin Comment vào 1 dictionary

2) Tại sheet Sum
- Bỏ hết comment cũ
- duyệt qua từng ô, so sánh code và ngày tương ứng với key của dictionary, nếu thấy thì add vô array, với cột 1 là địa chỉ dòng, cột 2 là địa chỉ cột, cột 3 là comment
- Cuối cùng, loop array lấy địa chỉ ô và add comment vô

Xem file đính kèm nhé.
Đừng bấm nút "COMMENT", nếu không muốn cập nhật.

Option Explicit
Sub sum()
Dim lr&, i&, j&, k&, id As String, com, s, sb
Dim dic As Object, key, res(), arr(1 To 100000, 1 To 3), rng
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Comment")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng = .Range("A2:F" & lr).Value2
End With
For i = 1 To UBound(rng)
    id = rng(i, 2) & "|" & rng(i, 1)
    If Not dic.exists(id) Then
        dic.Add id, rng(i, 5) & "|" & rng(i, 6)
    Else
        dic(id) = dic(id) & "@" & rng(i, 5) & "|" & rng(i, 6)
    End If
Next
Sheets("Sum").Activate
With Range("A2").CurrentRegion
    rng = .Value2
    .ClearComments
End With
For i = 2 To UBound(rng)
    For j = 4 To UBound(rng, 2)
        id = rng(i, 1) & "|" & rng(1, j)
        If dic.exists(id) Then
            k = k + 1: arr(k, 1) = i + 1
            arr(k, 2) = j: arr(k, 3) = dic(id)
        End If
    Next
Next
For i = 1 To k
    com = Split(arr(i, 3), "@"): id = ""
    If UBound(com) = 0 Then
        sb = Split(com(0), "|")
        arr(i, 3) = "Quantity: " & sb(0) & vbLf & "Reason: " & sb(1)
    Else
        For Each sb In com
            s = Split(sb, "|")
            id = id & "Quantity: " & s(0) & ", Reason: " & s(1) & vbLf
        Next
        arr(i, 3) = id
    End If
    Cells(arr(i, 1), arr(i, 2)).AddComment arr(i, 3)
'them . interior.color vao day, neu muon to mau cell
Next
End Sub

Cảm ơn bạn nhiều

 

[huyhoang_mmyeht]

Bạn có thể giúp mình theo file sau nhé nó khó hơn

tks bạn.

 

[bebo021999]

Bạn có thể giúp mình theo file sau nhé nó khó hơn

tks bạn.

Chẳng có gì khó cả.
Chỉ khó là chạy theo mệt quá. Phải chi đưa data thực ngay từ đầu thì xử luôn1 lần là xong rồi.

 

[huyhoang_mmyeht]

cố giúp mình với bạn
tks bạn nhiều