ค้นหารหัสที่ถูกต้องและออก comment dymamic ให้ตรง

[bkkrong]

ผมพยายามสร้าง comment โดยให้ตรวจสอบ ว่า ใน sheet1! column : J มีค่าเป็น ."Y" หรือไม่ ถ้าไม่มี ไม่ออก comment ถ้ามี ให้กลับไป check --> holdingBuy!B4:AZ38 ว่าตรงกับรหัส item อะไร ใน sheet1! column : D ที่ตรงกัน เพื่อนำเอาค่า comment ใน holdingBuy!B43:AZ43 ที่ตรงกันมาออก comment

ประเด็นคือ การออก comment ออกได้ตรงตามรหัส แต่
1 ผมไม่สามารถเขียน code ให้ระบบตรวจรหัส ใน sheet1! column : D = lookup holdingBuy!B43:AZ43 ได้ และให้มันไล่เช็คลงมาเรื่องๆ เพื่อออก comment ผมจึงทำได้แค่ input box ทดลอง (อยากเปลี่ยนตรงนี้)
2 ผมทดลอง ปรากฎว่า แม้ผมให้ target ออก comment sheet ที่ 1 แต่เมื่อไรผมไป sheet อื่น มันออก comment ใน sheet ที่ active นั้น
3 จะปรับขนาดพื้นที่ comment อย่างไร ที่อ่านได้หมด ส่วนใหญ่ตกขอบหมด
กรุณาช่วยปรับ code ให้ด้วยครับ

ขอบคุณครับ

****module4******

Code: Select all

' test comment almost OK

Sub Find_First()
    Dim FindString As String
    Dim cmt As String
    Dim cm As comment
    Dim rng As Range
     Dim sResult As String
      Dim tar As Range: Set scr = Worksheets("holdingBuy").Range("B43:AZ43") 'lookup comment
     Dim src As Range: Set tar = Worksheets("sheet1").Range("J3:J13") 'set location comment
         
         
     For i = 0 To tar.Rows.Count - 1
        For j = 0 To tar.Columns.Count - 1
     
    'FindString = ActiveCell.Offset(0, -6).Value  ' ----------how to
    FindString = InputBox("Enter a Search value")
    If Trim(FindString) <> "" Then
        With Sheets("holdingBuy").Range("B4:AZ38")
            Set rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not rng Is Nothing Then
          cmt = Worksheets("holdingBuy").Cells(43, rng.Column).Value
            
            MsgBox cmt
            ' found item_id
            
        If Worksheets("sheet1").Cells(tar.Row + i, tar.Column + j).Value = "Y" Then
           MsgBox "find Yes"
    sResult = cmt

        With Cells(tar.Row + i, tar.Column + j)
            .ClearComments
            .AddComment
            .comment.Text Text:=sResult
        End With
        Else
         MsgBox "not holdingbuy!!!"
       ' With Cells(tar.Row + i, tar.Column + j)
           ' .ClearComments
        
           ' .AddComment
           ' .comment.Text Text:=sResult
         ' End With
           
         
          End If
     
      
           ' .comment.Text Text:="Column A = & val1"
               'Sheets("holdingBuy").rng("A1").AddComment().Text = "Regular Comment"
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
     Next j
        
    Next i
            

End Sub

[bkkrong]

pic

[snasui]

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

Code: Select all

Sub Test0()
    Dim rAll As Range, r As Range
    Dim rhAll As Range, rh As Range
    Dim strCmt As String, found As Boolean
    
    With Sheets("Sheet1")
        Set rAll = .Range("j3", .Range("j" & .Rows.Count).End(xlUp))
        For Each r In rAll
            If r.Value = "Y" Then
                found = False
                With .Parent.Sheets("holdingBuy")
                    Set rhAll = .Range("b4:az38")
                    For Each rh In rhAll
                        If rh.Value = r.Offset(0, -6).Value Then
                            strCmt = .Cells(43, rh.Column)
                            found = True
                            Exit For
                        End If
                    Next rh
                End With
                If found Then
                    If r.comment Is Nothing Then
                        r.AddComment
                    End If
                    r.comment.Text strCmt
                End If
            Else
                If Not r.comment Is Nothing Then
                    r.ClearComments
                End If
            End If
        Next r
    End With
End Sub