การ Insert Comment อย่างรวดเร็วและทำได้ทีละหลายช่อง

[godman]

อาจารย์ครับผมมีปัญหามาถาม ถ้าผมอยากจะ insert comments มากๆและหลายๆ เซลล์โดยมีข้อมูลในอีกชี้ตตามไฟล์แนบ ผมจะต้องทำอย่างไรครับ แทนที่ผมจะมานั่งคีย์ทีละอันเพราะมี comment ที่ต้องใส่ทีละ มากๆ

[bank9597]

ลองดูครับ

ที่ B2 กด Ctrl+C
คลุมทึบ C2:AV2 แล้วคลิ๊กขวา Paste Special ใน Paste เลือก All ใน Operation เลือก Add > OK

[godman]

ขอบคุณครับคุณ bank แต่ยังไม่ใช่ตามความต้องการครับ ผมต้องการนำข้อมูลจาก Sheet iso9001clause มาใส่เป็น Comment ในsheet Comment โดยมีหมายเลขข้อกำหนดที่ผมใส่ สมมุติไว้ 2 อัน แต่อันที่เหลือผมยังไม่ใส่คือ C2 ถึง AV2 ไม่ใช่การ Copy แต่อย่างใดครับ

[snasui]

การเพิ่ม Comment หรือนำค่าจาก Comment มาเรียงเป็น Database แบบรวดเร็ว จำเป็นต้องพึ่ง VBA ครับ ลองบันทึก Macro สำหรับงานนี้มาดูก่อนครับ ติดตรงไหนสามารถถามมาได้เรื่อย ๆ ครับ

[godman]

อาจารย์ครับผมได้ทดลอง VBA นี้ก็ได้แต่เฉพาะเซลล์แบบแนวดิ่งได้เซลล์เดียวคือ A1 โดยใส่ข้อมูลที่ต้องการลิ้ง insert comment ใน H2 แต่ผมไม่ทราบว่าในกรณีของไฟล์ผมต้องปรับปรุงแก้ไขสูตรอย่างไรครับ ขอความกรุณาด้วยครับ

Code: Select all

Option Explicit
Sub AddCommentTest()
    With ActiveSheet
        If .Range("A1").comment Is Nothing Then
            'do nothing
        Else
            'delete existing comment
            .Range("A1").comment.Delete
        End If
        .Range("a1").AddComment Text:=.Range("H1").Text
    End With
nd SubE

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Option Explicit
Sub AddCommentTest()
    Dim rs As Range
    Dim rt As Range
    Dim r As Range
    Dim i As Integer
    With Sheets("ISO9001Clause")
        Set rs = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
    End With
    Set rt = Sheets("cOMMENTS").Range("B2")
    For Each r In rs
        With Sheets("cOMMENTS")
            If Not rt.Offset(0, i).Comment Is Nothing Then
                rt.Offset(0, i).Comment.Delete
                rt.Offset(0, i).AddComment Text:=r.Value
            Else
                rt.Offset(0, i).AddComment Text:=r.Value
            End If
        End With
        i = i + 1
    Next r
End Sub

[godman]

ขอบคุณมากครับที่ช่วยเหลือ ใช้ได้ดีเลยครับ ในแนว row แต่ว่าผมอยากลองแนวตั้ง colump ดูเผื่อมีสถานการณ์ที่ข้อมูลเป็นแนวตั้ง ปรากฏว่ามันใช้งานไม่ได้ โดยผมเปลี่ยนจาก rows.count ไปเป็น columns.count ไม่ทราบเกิดจากอะไรครับ ตามโค้ดนี้

Code: Select all

Option Explicit
Sub AddCommentTest()
    Dim rs As Range
    Dim rt As Range
    Dim r As Range
    Dim i As Integer
    With Sheets("ISO9001Clause")
        Set rs = .Range("B2", .Range("B" & Columns.Count).End(xlUp))
    End With
    Set rt = Sheets("cOMMENTS").Range("B2")
    For Each r In rs
        With Sheets("cOMMENTS")
            If Not rt.Offset(0, i).Comment Is Nothing Then
                rt.Offset(0, i).Comment.Delete
                rt.Offset(0, i).AddComment Text:=r.Value
            Else
                rt.Offset(0, i).AddComment Text:=r.Value
            End If
        End With
        i = i + 1
    Next r
End Sub

[godman]

ผมส่งไฟล์ที่ผมทำล่าสุดมาให้ครับ

[snasui]

ที่ไม่ได้เนื่องจากยังไม่เข้าใจ Code ที่ผมเขียนให้ครับ ลองดู Code ด้านล่างเปรียบเทียบกับ Code ก่อนหน้า สังเกตตรง rt.Offset ครับ

Code: Select all

Option Explicit
Sub AddCommentTest()
    Dim rs As Range
    Dim rt As Range
    Dim r As Range
    Dim i As Integer
    With Sheets("ISO9001Clause")
        Set rs = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
    End With
    Set rt = Sheets("cOMMENTS").Range("B2")
    For Each r In rs
        With Sheets("cOMMENTS")
            If Not rt.Offset(i, 0).Comment Is Nothing Then
                rt.Offset(i,0).Comment.Delete
                rt.Offset(i,0).AddComment Text:=r.Value
            Else
                rt.Offset(i,0).AddComment Text:=r.Value
            End If
        End With
        i = i + 1
    Next r
End Sub

[godman]

ขอบพระคุณมากครับ