HIển thị dữ liệu với comments

[Masu1991]

Xin chào Anh/Chị,
Em có một file báo cáo, còn 1 phần chưa biết cách xử lý như thế nào, nhờ các Anh/Chị hỗ trợ.
Mô tả vấn đề:
- Sheet Input là để nhập thông tin dữ liệu.
- Sheet report là để tổng hợp dữ liệu từ sheet Input.
vấn đề của em là làm sao khi bấm chuột vào ô "Xem dữ liệu" thì sẽ hiển thị thông tin theo Xưởng, Line, ngày ở dạng comment (có thể thay thế 1 ý tưởng khác).



Cảm ơn Anh Chị đã hỗ trợ.

 

[BuiQuangThuan]

Bạn muốn hiển thị như nào. Thử điền mẫu thử coi nào

 

[Masu1991]

Bạn muốn hiển thị như nào. Thử điền mẫu thử coi nào

Dạ, Ví dụ như em muốn xem dữ liệu của dòng 1: thì em sẽ bấm vào ô xem dữ liệu.
- thì sẽ hiển thị ra bảng chứa tất cả thông tin: tương ứng điều kiện là là Building: CA, Line A01 và ngày 08/01

 

[heyhey1994]

Check lại xem đúng chưa nha bạn

 

[Maika8008]

Cột điểm ý nghĩa làm sao mà thấy khó hiểu thế? Cứ có ngày, có chủ quản... là bị trừ điểm!

 

[htin1997]

Cột điểm ý nghĩa làm sao mà thấy khó hiểu thế?

Thì khó hiểu nên chủ thớt mới yêu cầu "HIển thị dữ liệu với comments" đó ạ.
Audit 5S nhưng form thì không 5S cho lắm

 

[Masu1991]

Cột điểm ý nghĩa làm sao mà thấy khó hiểu thế? Cứ có ngày, có chủ quản... là bị trừ điểm!

Dạ, điềm này mặc định là 100 điểm, cứ mỗi lần xuất hiện dữ liệu ở sheet Input là sẽ bị trừ đi 5điểm ạ

Bài đã được tự động gộp: 7/8/23

Check lại xem đúng chưa nha bạn

Em sử dụng office 2019 nên hàm xlookup không sử dụng được ạ,

 

[heyhey1994]

Dạ, điềm này mặc định là 100 điểm, cứ mỗi lần xuất hiện dữ liệu ở sheet Input là sẽ bị trừ đi 5điểm ạ

Bài đã được tự động gộp: 7/8/23

Em sử dụng office 2019 nên hàm xlookup không sử dụng được ạ,

Sub xxx()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lr1 As Long
    Dim lr2 As Long
    Dim data1 As String
    Dim i As Long
    
    Set ws1 = ThisWorkbook.Sheets("report")
    Set ws2 = ThisWorkbook.Sheets("input")
    lr1 = ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
    lr2 = ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row
    
    With ws1
        .Range("I4:I" & lr1).ClearComments
        For i = 4 To lr1
            data1 = FindCorrespondingValue(.Range("B" & i) & .Range("C" & i) & CDbl(.Range("D" & i)) & .Range("E" & i), ws2.Range("I3:I" & lr2), ws2.Range("A3:A" & lr2))
            .Range("I" & i).AddComment
            .Range("I" & i).Comment.Visible = False
            .Range("I" & i).Comment.Text Text:=data1
        Next i
    End With
End Sub

Function FindCorrespondingValue(searchValue As String, searchRange As Range, resultRange As Range) As String
    Dim i As Long
    For i = 1 To searchRange.Rows.Count
        If searchRange.Cells(i, 1).Value = searchValue Then
            FindCorrespondingValue = resultRange.Cells(i, 1).Value & Chr(10) & resultRange.Cells(i, 2).Value & Chr(10) & resultRange.Cells(i, 3).Value
            Exit Function
        End If
    Next i
    FindCorrespondingValue = "Nothing"
End Function

Thay đổi dòng này theo nhu cầu nhé: FindCorrespondingValue = resultRange.Cells(i, 1).Value & Chr(10) & resultRange.Cells(i, 2).Value & Chr(10) & resultRange.Cells(i, 3).Value

 

[bebo021999]

Một cách khác. click chọn ô nào thì ô đó sẽ hiển thị nội dung (thông qua Validation)
Số ký tự tối đa: 250

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lr&, i&, st As String, st2 As String, rng
lr = Cells(Rows.Count, "I").End(xlUp).Row
If Intersect(Target, Range("I4:I" & lr)) Is Nothing Or Target.Count > 1 Then Exit Sub
st = Target.Offset(0, -7) & "|" & Target.Offset(0, -6) & "|" & Target.Offset(0, -5).Value2 & "|" & Target.Offset(0, -4)
With Sheets("input")
    lr = .Cells(Rows.Count, "E").End(xlUp).Row
    rng = .Range("A3:H" & lr).Value2
    For i = 1 To UBound(rng)
        If rng(i, 5) & "|" & rng(i, 6) & "|" & rng(i, 7) & "|" & rng(i, 8) = st Then
            st2 = IIf(st2 = "", "", st2) & rng(i, 1) & "-" & rng(i, 2) & "-" & rng(i, 3) & vbLf
        End If
    Next
End With
With Target.Validation
    .Delete
    .Add Type:=xlValidateInputOnly
    .InputMessage = Left(st2, 250)
End With
End Sub

 

[Masu1991]

Một cách khác. click chọn ô nào thì ô đó sẽ hiển thị nội dung (thông qua Validation)
Số ký tự tối đa: 250

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lr&, i&, st As String, st2 As String, rng
lr = Cells(Rows.Count, "I").End(xlUp).Row
If Intersect(Target, Range("I4:I" & lr)) Is Nothing Or Target.Count > 1 Then Exit Sub
st = Target.Offset(0, -7) & "|" & Target.Offset(0, -6) & "|" & Target.Offset(0, -5).Value2 & "|" & Target.Offset(0, -4)
With Sheets("input")
    lr = .Cells(Rows.Count, "E").End(xlUp).Row
    rng = .Range("A3:H" & lr).Value2
    For i = 1 To UBound(rng)
        If rng(i, 5) & "|" & rng(i, 6) & "|" & rng(i, 7) & "|" & rng(i, 8) = st Then
            st2 = IIf(st2 = "", "", st2) & rng(i, 1) & "-" & rng(i, 2) & "-" & rng(i, 3) & vbLf
        End If
    Next
End With
With Target.Validation
    .Delete
    .Add Type:=xlValidateInputOnly
    .InputMessage = Left(st2, 250)
End With
End Sub

Dạ, Em cảm ơn anh rất nhiều ạ

Bài đã được tự động gộp: 8/8/23

Sub xxx()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lr1 As Long
    Dim lr2 As Long
    Dim data1 As String
    Dim i As Long
   
    Set ws1 = ThisWorkbook.Sheets("report")
    Set ws2 = ThisWorkbook.Sheets("input")
    lr1 = ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
    lr2 = ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row
   
    With ws1
        .Range("I4:I" & lr1).ClearComments
        For i = 4 To lr1
            data1 = FindCorrespondingValue(.Range("B" & i) & .Range("C" & i) & CDbl(.Range("D" & i)) & .Range("E" & i), ws2.Range("I3:I" & lr2), ws2.Range("A3:A" & lr2))
            .Range("I" & i).AddComment
            .Range("I" & i).Comment.Visible = False
            .Range("I" & i).Comment.Text Text:=data1
        Next i
    End With
End Sub

Function FindCorrespondingValue(searchValue As String, searchRange As Range, resultRange As Range) As String
    Dim i As Long
    For i = 1 To searchRange.Rows.Count
        If searchRange.Cells(i, 1).Value = searchValue Then
            FindCorrespondingValue = resultRange.Cells(i, 1).Value & Chr(10) & resultRange.Cells(i, 2).Value & Chr(10) & resultRange.Cells(i, 3).Value
            Exit Function
        End If
    Next i
    FindCorrespondingValue = "Nothing"
End Function

Thay đổi dòng này theo nhu cầu nhé: FindCorrespondingValue = resultRange.Cells(i, 1).Value & Chr(10) & resultRange.Cells(i, 2).Value & Chr(10) & resultRange.Cells(i, 3).Value

Dạ, Em cảm ơn