Lập trình VBA để chèn comment dựa theo thông tin

[hoangtran1176]

Chào mọi người.
Nhờ mọi người hỗ trợ giúp code VBA để chèn comment dựa theo thông tin.
Mình có đính kèm yêu cầu trong file.

 

[Hoàng Tuấn 868]

Chào mọi người.
Nhờ mọi người hỗ trợ giúp code VBA để chèn comment dựa theo thông tin.
Mình có đính kèm yêu cầu trong file.

View attachment 301587 View attachment 301588

Bạn này thấy bài trước đây cũng viết code rồi, sao không viết tiếp đi nhỉ.

 

[hoangtran1176]

Bạn này thấy bài trước đây cũng viết code rồi, sao không viết tiếp đi nhỉ.

Mình viết được tiếp thì nhờ mọi người trên này chi nữa =)).

 

[huuthang_bd]

Chào mọi người.
Nhờ mọi người hỗ trợ giúp code VBA để chèn comment dựa theo thông tin.
Mình có đính kèm yêu cầu trong file.

View attachment 301587 View attachment 301588

Thử hàm này xem:

C4=SumWithComment(Sheet1!$B$3:$G$24,C$3,$B4)

--

Function SumWithComment(rTable As Range, dDate As Date, sType As String) As Double
Dim ThisCell As Range, aTable As Variant, i As Long, sComment As String
Set ThisCell = Application.Caller
aTable = rTable.Value2
For i = 1 To UBound(aTable, 1)
    If aTable(i, 1) = dDate And aTable(i, 4) = sType Then
        SumWithComment = SumWithComment + aTable(i, 5)
        sComment = sComment & ChrW(10) & aTable(i, 2) & " " & aTable(i, 3) & " " & aTable(i, 4) & " " & aTable(i, 5) & " " & aTable(i, 6)
    End If
Next
If SumWithComment = 0 Then
    If Not ThisCell.Comment Is Nothing Then
        ThisCell.Comment.Delete
    End If
Else
    If ThisCell.Comment Is Nothing Then
        ThisCell.AddComment
        ThisCell.Comment.Shape.Width = 260
        ThisCell.Comment.Shape.TextFrame.Characters.Font.Bold = False
    End If
    ThisCell.Comment.Text Mid(sComment, 2)
    ThisCell.Comment.Visible = False
End If
End Function

 

[hoangtran1176]

Thử hàm này xem:

C4=SumWithComment(Sheet1!$B$3:$G$24,C$3,$B4)

--

Function SumWithComment(rTable As Range, dDate As Date, sType As String) As Double
Dim ThisCell As Range, aTable As Variant, i As Long, sComment As String
Set ThisCell = Application.Caller
aTable = rTable.Value2
For i = 1 To UBound(aTable, 1)
    If aTable(i, 1) = dDate And aTable(i, 4) = sType Then
        SumWithComment = SumWithComment + aTable(i, 5)
        sComment = sComment & ChrW(10) & aTable(i, 2) & " " & aTable(i, 3) & " " & aTable(i, 4) & " " & aTable(i, 5) & " " & aTable(i, 6)
    End If
Next
If SumWithComment = 0 Then
    If Not ThisCell.Comment Is Nothing Then
        ThisCell.Comment.Delete
    End If
Else
    If ThisCell.Comment Is Nothing Then
        ThisCell.AddComment
        ThisCell.Comment.Shape.Width = 260
        ThisCell.Comment.Shape.TextFrame.Characters.Font.Bold = False
    End If
    ThisCell.Comment.Text Mid(sComment, 2)
    ThisCell.Comment.Visible = False
End If
End Function

Cảm ơn bạn, nhưng mình gặp 1 vấn đề không thể chỉnh được cỡ chữ của comment, bạn có thể code them giúp mình được không
Thanks.

 

[huuthang_bd]

Cảm ơn bạn, nhưng mình gặp 1 vấn đề không thể chỉnh được cỡ chữ của comment, bạn có thể code them giúp mình được không
Thanks.

Không thay đổi cỡ chữ của comment khi dùng ở dạng công thức một cách thông thường được nha bạn. Để làm thì phải code tương đối phức tạp.

 

[hoangtran1176]

Không thay đổi cỡ chữ của comment khi dùng ở dạng công thức một cách thông thường được nha bạn. Để làm thì phải code tương đối phức tạp.

Oh, Cái này mình có thể cài đặt mặc định luôn trên file excel được không bạn.
Mình cảm ơn

 

[huuthang_bd]

Oh, Cái này mình có thể cài đặt mặc định luôn trên file excel được không bạn.
Mình cảm ơn

Cái này thuộc về hệ thống, chỉnh được nhưng sẽ ảnh hưởng những cái khác nữa chứ không phải chỉ chỉnh cho comment của Excel.