วิธีใช้ macro ดึงข้อความใน Cell ไป insert เป็น comment

[natcharrr]

สวัสดีค่ะ ท่านอาจารย์และผู้รู้ทุกท่าน
ดิฉันขอคำปรึกษาเรื่องการใช้ Macro ช่วยในการทำงานหน่อยนะคะ

ไม่แน่ใจว่าจะพอเป็นไปได้มั้ยคะ
ถ้าเราจะนำข้อความใน Cells หนึ่ง ไปใช้เป็น Insert comment ของอีก Cells หนึ่งตาม Matching ที่เราต้องการ
โดยใช้ Macro เป็นตัวบันทึกให้อัตโนมัติน่ะค่ะ

ในที่นี้ดิฉันต้องการดึง Remark เหตุผลของการใช้เวลาที่ Late ไปจากปกติ แยกตามหัวข้อต่างๆ จากในหน้าหนึ่งไปยังอีกหน้าหนึ่ง
และได้ลองใช้วิธีการบันทึกเป็น Macro ดู ปรากฎว่าโค้ดที่ใช้นั้น Error ค่ะ
โดยจุดที่ดิฉันยังติดปัญหาคือ ต้องการทำการ Insert comment ข้าม Sheet โดยที่ค่าที่ Insert จะเปลี่ยนไปเรื่อยๆตามการกรอกข้อมูลเข้ามาของ User น่ะค่ะ

Code: Select all

Private Sub CommandButton2_Click()
  
    [color=#BF0000]Sheets("Table record").Select
    Range("AJ6").AddComment
    Range("AJ6").Comment.Visible = False
    Range("AJ6").Comment.Text Text:="'ER stroke form'!R[20]c[-45]"
    Sheets("ER stroke form").Select[/color]
End Sub

โค้ดที่ใช้ insert comment คือตัวอักษรสีแดงนะคะ

จึงใคร่ขอคำปรึกษาจากอาจารย์และผู้รู้ทุกท่านด้วยนะคะ
ขอบพระคุณมากๆค่ะ

[snasui]

ช่วยอธิบายมาเพิ่มเติมว่าต้องการนำ Comment ในชีต ER stroke form ไปไว้ที่เซลล์ใด โดยพิจารณาจากเงื่อนไขใดจะได้เข้าใจตรงกันครับ

[natcharrr]

ขออภัยค่ะ
ต้องการนำ Comment ใน ชีต ER stroke form ไปไว้ที่เซลล์ในชีต Table record ค่ะ
โดยเงื่อนไขคือต้องการให้ข้อความในหน้าชีต ER stroke form ที่ User คีย์ ไว้ไปบันทึกที่ชีต Table record ไปเรื่อยๆ ทีละบรรทัดค่ะ โดยเริ่มบันทึกบรรทัดแรกที่ row ที่ 6 ในชีต Table record
ซึ่งดิฉันได้ลองทำปุ่มคำสั่งการดึงข้อมูลเอาไปบันทึกเอาไว้บ้างแล้ว (ผ่านปุ่ม Save) ขาดแต่ข้อความ Remark ที่ต้องการดึงไปเป็น Comment ด้วยค่ะ โดยส่วนที่ต้องการดึงมีรายละเอียดดังนี้

ข้อความในเซลล์ M27 ไป comment ที่ Column AH
ข้อความในเซลล์ M28 ไป comment ที่ Column AJ
ข้อความในเซลล์ M29 ไป comment ที่ Column AM
ข้อความในเซลล์ M30 ไป comment ที่ Column AP
ข้อความในเซลล์ M31 ไป comment ที่ Column AS
ข้อความในเซลล์ M32 ไป comment ที่ Column AU
ข้อความในเซลล์ M34 ไป comment ที่ Column AX
ข้อความในเซลล์ M35 ไป comment ที่ Column BA

ขอบพระคุณค่ะ.

[snasui]

ดูจากค่าใดในชีต ER stroke form และ Table record เพื่อที่จะได้นำ Comment ไปวางให้ตรงบรรทัดตามที่ต้องการครับ

[natcharrr]

ดูจากค่าใดในชีต ER stroke form และ Table record เพื่อที่จะได้นำ Comment ไปวางให้ตรงบรรทัดตามที่ต้องการครับ

ไม่แน่ใจว่าเข้าใจคำถามถูกหรือเปล่านะคะ
ดูจากข้อความ Remark ที่เป็น Text ทั้งหมดที่ User ใส่มาใน Column M หน้าชีท ER Strock
ไปใส่เป็น Comment ไว้ที่เซลล์ที่มีค่าเป็นเวลา Acheived time ของแต่ละขั้นตอน ในตารางหน้า Table record ค่ะ
ขอบคุณค่ะ

[logic]

อาจารย์หมายถึงว่าเอาไปวางบรรทัดไหน ปลายทางมีตั้งหลายบรรทัด หรือว่าให้วางทุกบรรทัดครับ

[natcharrr]

อาจารย์หมายถึงว่าเอาไปวางบรรทัดไหน ปลายทางมีตั้งหลายบรรทัด หรือว่าให้วางทุกบรรทัดครับ

ขอบคุณนะคะที่ช่วยอธิบาย
วางทุกบรรทัดค่ะ โดยเริ่มวางตั้งแต่บรรทัดที่ 6 ไล่ไปเรื่อยๆค่ะ

ขอบคุณมากๆค่ะ.

[snasui]

ตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Dim rsTemp As Range, arrComment() As Variant, rs As Range
Dim rtAll As Range, rtCol As Range, i As Integer, j As Integer
With Sheets("ER stroke form")
    Set rsTemp = .Range("m26:m35")
    i = 0
    For Each rs In rsTemp
        If rs.Value <> "" Then
            ReDim Preserve arrComment(i)
            arrComment(i) = rs.Value
            i = i + 1
        End If
    Next rs
End With
With Sheets("Table record")
    Set rtAll = .Range("ah6:ba12")
    For i = 1 To rtAll.Rows.Count
        j = 0
        Set rtCol = rtAll.Rows(i)
        For Each r In rtCol.Cells
            If r.EntireColumn.Hidden = False Then
                If r.Comment Is Nothing Then
                    r.AddComment
                    r.Comment.Text Text:=arrComment(j)
                Else
                    r.Comment.Text Text:=arrComment(j)
                End If
                j = j + 1
            End If
        Next r
    Next i
End With

[natcharrr]

ตัวอย่าง Code ตามด้านล่างครับ

Code: Select all

Dim rsTemp As Range, arrComment() As Variant, rs As Range
Dim rtAll As Range, rtCol As Range, i As Integer, j As Integer
With Sheets("ER stroke form")
    Set rsTemp = .Range("m26:m35")
    i = 0
    For Each rs In rsTemp
        If rs.Value <> "" Then
            ReDim Preserve arrComment(i)
            arrComment(i) = rs.Value
            i = i + 1
        End If
    Next rs
End With
With Sheets("Table record")
    Set rtAll = .Range("ah6:ba12")
    For i = 1 To rtAll.Rows.Count
        j = 0
        Set rtCol = rtAll.Rows(i)
        For Each r In rtCol.Cells
            If r.EntireColumn.Hidden = False Then
                If r.Comment Is Nothing Then
                    r.AddComment
                    r.Comment.Text Text:=arrComment(j)
                Else
                    r.Comment.Text Text:=arrComment(j)
                End If
                j = j + 1
            End If
        Next r
    Next i
End With

ขอบคุณนะคะอาจารย์ Code ที่อาจารย์ให้มาสามารถนำไปใช้ใส่เป็น Comment ได้เลยค่ะ
แต่ขอรบกวนขอคำปรึกษาเพิ่มเติมอีกครั้งนึงนะคะ

ถ้าดิฉันต้องการนำ Comment ไปวางไว้ในเซลล์ซึ่งไม่ได้อยู่ติดกันเป็นช่วง Range แบบที่อ.กำหนดมาให้ คือ
Set rtAll = .Range("ah6:ba12")

ดิฉันจะสามารถกำหนดเซลล์ที่ต้องการใส่ Comment เป็น Set rtAll = .Range("AH6","AJ7","AM7","AP6","AS6","AU6","AX6","BA6") ได้หรือไม่คะอาจารย์ พอดิฉันใช้กำหนดแบบนี้แล้วคำสั่งก็ไม่ทำงานเลยค่ะ หรือจะเป็นเพราะเรากำหนดตัวที่ดึงมาเป็น Range จึงต้องวางเป็น Range ด้วยหรือเปล่าคะ แล้วเราจะมีวิธีแก้ปัญหานี้อย่างไรบ้างคะอาจารย์ รบกวนอีกครั้งนะคะ

ขอบพระคุณค่ะ

[snasui]

การกำหนดลักษณะที่อธิบายน้้นคงไม่ต้อง Loop เพราะต้องการวางในตำแหน่งที่คงที่ สามารถนำค่าในเซลล์ต้นทางไปวางปลายทางแบบเซลล์ต่อเซลล์ได้เลย ลองเขียนมาเองก่อน ติดตรงไหนค่อยถามกันต่อครับ

[natcharrr]

ลองเขียนโค้ดมาใหม่ค่ะ
โดยแยก Range (m26:m35) เป็นคอลัมน์ เพื่อแยกวางใหม่ในอีกหน้า ซึ่งแต่ละคอลัมน์ที่ต้องการวางไม่ได้อยู่ติดกัน
วางไปเรื่อยๆตามข้อมูลที่คีย์ เข้ามาค่ะ ในที่นี้กำหนดให้วางตั้งแต่แถวที่ 6 ลงไปเรื่อยจนถึงแถวที่ 101 ค่ะ

Code: Select all

Dim rsTemp As Range, arrComment() As Variant, rs As Range
Dim rtAll As Range, rtCol As Range, i As Integer, j As Integer
With Sheets("ER stroke form")
    Set rsTemp = .Range("m26,m27,m28,m29,m30,m31,m32,m33,m34,m35")
    i = 0
    For Each rs In rsTemp
        If rs.Value <> "" Then
            ReDim Preserve arrComment(i)
            arrComment(i) = rs.Value
            i = i + 1
        End If
    Next rs
End With
With Sheets("Table record")
    Set rtAll = .Range("ag6:ag101,ah6:ah101,aj6:aj101,am6:am101,ap6:ap101,as6:as101,au6:au101,ax6:ax101,ba6:ba101")
    For i = 1 To rtAll.Rows.Count
        j = 0
        Set rtCol = rtAll.Rows(i)
        For Each r In rtCol.Cells
            If r.EntireColumn.Hidden = False Then
                If r.Comment Is Nothing Then
                    r.AddComment
                    r.Comment.Text Text:=arrComment(j)
                Else
                    r.Comment.Text Text:=arrComment(j)
                End If
                j = j + 1
            End If
        Next r
    Next i
End With

แต่ปรากฎว่าพอกดปุ่มคำสั่งแล้วเกิด Error ค่ะ พอกลับไปใช้โค้ดเดิมก็ไม่เหมือนเดิมแล้ว
ขอคำแนะนำจากอาจารย์และท่านผู้รู้ด้วยนะคะ
ต้องการนำข้อความที่ remark ในช่วง m25:m36 ไปวางอีกชีต (Table record) ในคอลัมน์ที่ต้องการคือ AG,AH,AJ,AM,AP,AS,AU,AX,BA
วางตั้งแต่บรรทัดที่ 6 ถัดไปเรื่อยๆ จนถึง บรรทัดที่ 101 โดยผ่านปุ่มคำสั่ง Save ค่ะ

ขอบพระคุณมากๆค่ะ.

[ZEROV]

ต้องการนำข้อความที่ remark ในช่วง m25:m36 ไปวางอีกชีต (Table record) ในคอลัมน์ที่ต้องการคือ AG,AH,AJ,AM,AP,AS,AU,AX,BA
วางตั้งแต่บรรทัดที่ 6 ถัดไปเรื่อยๆ จนถึง บรรทัดที่ 101 โดยผ่านปุ่มคำสั่ง Save ค่ะ

สมมติว่า Sub AddComments ตอบปัญหานี้ได้
้HN เป็น Range Name ที่อ้างอิงเซลล์ใด
remark เป็น Range Name ที่อ้างอิงช่วงเซลล์ใด


@Sheet2 Module

Code: Select all

Public Sub AddComments()
Dim arrCols, r As Integer

r = Columns("a:a").Find([HN]).Row

arrCols = Array("AG", "AH", "AJ", "AM", "AP", "AS", "AU", "AX", "BA")
 For Each arr In arrCols
 n = n + 1
 arr = arr & r
 With Range(arr)
     CommentText = [remark].Resize(1, 1).Offset(n - 1, 0).Value
    .AddComment
    .Comment.Visible = False
    .Comment.Text CommentText
 End With
 Next
End Sub

[snasui]

อีกตัวอย่าง Code ครับ

Code: Select all

Dim rsTemp As Range, arrComment() As Variant
Dim rtAll As Range, rs As Range, i As Integer, j As Integer
With Sheets("ER stroke form")
    Set rsTemp = .Range("m26:m35")
    i = 0
    For Each rs In rsTemp
        If rs.Value <> "" Then
            ReDim Preserve arrComment(i)
            arrComment(i) = rs.Value
            i = i + 1
        End If
    Next rs
End With
With Sheets("Table record")
    Set rtAll = .Range("AG5,AH5,AJ5,AM5,AP5,AS5,AU5,AX5,BA5")
    For i = 0 To .Range("ag5", .Range("ag5").End(xlDown)).Rows.Count - 1
        j = 0
        For Each r In rtAll
            If r.Offset(i, 0).Comment Is Nothing Then
                r.Offset(i, 0).AddComment
                r.Offset(i, 0).Comment.Text Text:=arrComment(j)
            Else
                r.Offset(i, 0).Comment.Text Text:=arrComment(j)
            End If
            j = j + 1
        Next r
    Next i
End With

[ZEROV]

หลังจากดูโค้ดของอาจารย์คนควนทำให้ผมกลับไปทบทวนความต้องการของผู้ถาม(กระบวนการทำงาน) ดังนี้

1.ป้อนข้อมูลลงในแบบฟอร์ม"ER stroke form" สำหรับ HN เดียว(อาจจะซำ้ในการบันทึกครั้งหลังๆ)
2.ส่งข้อมูลไปเก็บเป็น Recordในชีท Table record ยกเว้น Remark ที่ต้องการเก็บเป็น Comment(ไม่ใช่ค่าในCell)
โดยข้อมูลจะไปต่อจากแถวสุดท้ายของTable record

จากข้อ 1.และ 2.
Sub AddCommentsจะต้องใช้ก่อน end sub

r = Columns("a:a").Find([HN]).Row
แก้เป็น
r=range("a" & rows.count).end(xlup).row

[ZEROV]

หลังจากดูโค้ดของอาจารย์คนควนทำให้ผมกลับไปทบทวนความต้องการของผู้ถาม(กระบวนการทำงาน) ดังนี้

1.ป้อนข้อมูลลงในแบบฟอร์ม"ER stroke form" สำหรับ HN เดียว(อาจจะซำ้ในการบันทึกครั้งหลังๆ)
2.ส่งข้อมูลไปเก็บเป็น Recordในชีท Table record ยกเว้น Remark ที่ต้องการเก็บเป็น Comment(ไม่ใช่ค่าในCell)
โดยข้อมูลจะไปต่อจากแถวสุดท้ายของTable record

จากข้อ 1.และ 2.
Sub AddCommentsจะต้องใช้ก่อน end sub

Code: Select all

Private Sub CommandButton2_Click()
....................
....................
....................
Run "sheet2.addcomments"
End Sub

r = Columns("a:a").Find([HN]).Row
แก้เป็น
r=range("a" & rows.count).end(xlup).row

[natcharrr]

ขอบคุณอาจารย์คนควนและคุณ ZEROV มากๆนะคะ
ได้ตามที่ต้องการเลยค่ะ

แต่มีติดปัญหาเวลาเอาโค้ดไปใช้กับอีกไฟล์ ซึ่ง Duplicated กันมา ทำไมถึงนำไปใช้ไม่ได้เหรอคะ (มัน Error ค่ะ)
ทั้งๆที่ ชื่อชีตก็เหมือนกัน Range name ก็เหมือนกันหมด
ขอรบกวนอีกครั้งด้วยนะคะ
ขอบคุณค่ะ

[snasui]

Error ที่ว่านั้นมีลักษณะเป็นอย่างไร ลองจับภาพมาดูกัน หรือ ลบข้อความสำคัญทิ้งไป ตัดข้อมูลให้เหลือเพียงบางส่วนแล้วแนบไฟล์นั้นมาครับ

[ZEROV]

ขอบคุณอาจารย์คนควนและคุณ ZEROV มากๆนะคะ
ได้ตามที่ต้องการเลยค่ะ

แต่มีติดปัญหาเวลาเอาโค้ดไปใช้กับอีกไฟล์ ซึ่ง Duplicated กันมา ทำไมถึงนำไปใช้ไม่ได้เหรอคะ (มัน Error ค่ะ)
ทั้งๆที่ ชื่อชีตก็เหมือนกัน Range name ก็เหมือนกันหมด
ขอรบกวนอีกครั้งด้วยนะคะ
ขอบคุณค่ะ

ผมใช้ Worksheet Code Name ไม่ใช่ Worksheet Name ต้องระวังในการนำไปใช้ที่อื่น
อ่าน Worksheet Code Name
https://msdn.microsoft.com/en-us/librar ... 37552.aspx