Sắp xếp dữ liệu và trả kết quả vào mảng

[BuiQuangThuan]

Chào các thầy cô. Em có file demo như dưới
Kết quả trả về như phàn bôi màu vàng.
Nhờ thầy cô code giúp ạ.
Em cám ơn ạ

 

[saobekhonglac]

Chào các thầy cô. Em có file demo như dưới
Kết quả trả về như phàn bôi màu vàng.
Nhờ thầy cô code giúp ạ.
Em cám ơn ạ

Thử công thức này:

F3=IF(ISERROR(LOOKUP(2,1/($A$2:$A$8=$E3)/($B$2:$B$8=F$2))),"","X")

 

[BuiQuangThuan]

Thử công thức này:

F3=IF(ISERROR(LOOKUP(2,1/($A$2:$A$8=$E3)/($B$2:$B$8=F$2))),"","X")

có cách nào sử dụng VBA dc không ạ

 

[saobekhonglac]

có cách nào sử dụng VBA dc không ạ

VBA thì chờ các thành viên khác nha, mình không biết VBA đâu,

 

[concogia]

có cách nào sử dụng VBA dc không ạ

[F2:I2] có sẵn hay phải tìm luôn, đưa lại file có MÃ & KÝ HIỆu giống giống thật tý tẹo để viết code xong khỏi phải sửa
Thân

 

[BuiQuangThuan]

[F2:I2] có sẵn hay phải tìm luôn, đưa lại file có MÃ & KÝ HIỆu giống giống thật tý tẹo để viết code xong khỏi phải sửa
Thân

em muốn làm thử trên demo để em tham khảo học thôi. chứ có bác có công thức cũng giải quyết được rồi.cám ơn bác rất nhiều ạ
bác hỏi F2:I2 không cố đinh ạ. Tại nó có 103 mã cơ

 

[snow25]

Chào các thầy cô. Em có file demo như dưới
Kết quả trả về như phàn bôi màu vàng.
Nhờ thầy cô code giúp ạ.
Em cám ơn ạ

Thử cái code sau.

Sub linhtinh()
    Dim arr, dic As Object, dk As String, i As Long, j As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
         arr = .Range("a2:b8").Value
         For i = 1 To UBound(arr, 1)
             dk = arr(i, 1) & "#" & arr(i, 2)
             If Not dic.exists(dk) Then
                dic.Add dk, i
             End If
         Next i
         .Range("F3:i5").ClearContents
         arr = .Range("e2:i5").Value
         For i = 2 To UBound(arr, 1)
             For j = 2 To UBound(arr, 2)
                 dk = arr(i, 1) & "#" & arr(1, j)
                 If dic.exists(dk) Then
                    arr(i, j) = "X"
                 End If
             Next j
         Next i
         .Range("e2:i5").Value = arr
   End With
End Sub

 

[snow25]

Chào các thầy cô. Em có file demo như dưới
Kết quả trả về như phàn bôi màu vàng.
Nhờ thầy cô code giúp ạ.
Em cám ơn ạ

Thử code này.

Sub linhtinh()
    Dim arr, dic As Object, dk As String, i As Long, j As Long, arr1, a As Long, b As Long, c As Long, d As Long, dk1 As String, dk2 As String
    a = 1: b = 1
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
         arr = .Range("a2:b9").Value
         ReDim arr1(1 To UBound(arr, 1) + 1, 1 To UBound(arr, 1) + 1)
         For i = 1 To UBound(arr, 1)
             dk = arr(i, 1) & "#" & arr(i, 2)
             If Not dic.exists(dk) Then
                dic.Add dk, i
             End If
             dk1 = arr(i, 1) & "##"
             If Not dic.exists(dk1) Then
                a = a + 1
                arr1(a, 1) = arr(i, 1)
                dic.Add dk1, a
             End If
             dk2 = arr(i, 2) & "#"
             If Not dic.exists(dk2) Then
                b = b + 1
                arr1(1, b) = arr(i, 2)
                dic.Add dk2, b
             End If
             c = dic.Item(dk1)
             d = dic.Item(dk2)
             dk = arr1(c, 1) & "#" & arr1(d, 2)
             If Not dic.exists(dk) Then
                arr1(c, d) = "X"
             End If
         Next i
         .Range("K2").Resize(a, b).Value = arr1
   End With
End Sub