2 File có liên quan gì đến nhau đâu nhỉ.Bạn xem lại file gửi lên.Mọi chi tiết xin các bạn xem file đính kèm. Kính mong nhận được sự trợ giúp của các bạn . XIN TRÂN TRỌNG CẢM ƠN
Đúng File rồi mà bạn ơi - Mình đã giải thích rõ và cập nhật thử bằng tay ngày 10/11/2018 sang bên Sheet LENH rồi mà bạn. Bạn xem lại giúp mình nhé - Cảm ơn bạn đã quan tâm2 File có liên quan gì đến nhau đâu nhỉ.Bạn xem lại file gửi lên.
Bạn giải thích rõ lấy sang thế nào nhé.
Đây bạn xem.Không dùng công thức nhé.Đúng File rồi mà bạn ơi - Mình đã giải thích rõ và cập nhật thử bằng tay ngày 10/11/2018 sang bên Sheet LENH rồi mà bạn. Bạn xem lại giúp mình nhé - Cảm ơn bạn đã quan tâm
Sub chuyen()
Dim arr, arr1
Dim a As Long, b As Long
Dim s As String, s2 As String
Dim s1 As String
Dim dk As String
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
With Sheet1
s2 = .Range("C1").Value
arr = .Range("B5:o" & .Range("C" & Rows.Count).End(xlUp).Row).Value
End With
With Sheet2
arr1 = .Range("b8:D14").Value
s = .Range("D4").Value
For i = 3 To UBound(arr, 1)
If arr(i, 1) = Empty Then arr(i, 1) = arr(i - 1, 1)
For j = 6 To 12
If arr(i, j) <> Empty Then
dk = arr(i, 1) & "#" & arr(1, j)
If dic.exists(dk) = 0 Then
If arr(i, 2) = s2 Then
m = arr(i, j)
Else
m = arr(i, 2) & " = " & arr(i, j)
End If
dic.Item(dk) = Array(m)
Else
s = dic.Item(dk)(0)
If arr(i, 2) = s2 Then
s = s & " va " & arr(i, j)
Else
s = s & " va " & arr(i, 2) & " = " & arr(i, j)
End If
dic.Item(dk) = Array(s)
End If
End If
Next j
Next i
For i = 1 To 7
s1 = .Range("D4").Value
dk = s1 & "#" & arr1(i, 2)
If dic.exists(dk) Then
arr1(i, 3) = dic.Item(dk)(0)
Else
arr1(i, 3) = Empty
End If
Next i
.Range("B8:d14").Value = arr1
End With
End Sub
Cảm ơn bạn - Rất chuẩn . Nhưng cô bạn tôi chỉ muốn dùng công thức cho dễ tùy biến khi phát sinh trong quá trình sử dụng - Các Bạn có thể cho phương án dùng hàm được không ? Xin lỗi vì đã làm phiền bạnĐây bạn xem.Không dùng công thức nhé.
Mã:Sub chuyen() Dim arr, arr1 Dim a As Long, b As Long Dim s As String, s2 As String Dim s1 As String Dim dk As String Dim dic As Object Set dic = CreateObject("scripting.dictionary") With Sheet1 s2 = .Range("C1").Value arr = .Range("B5:o" & .Range("C" & Rows.Count).End(xlUp).Row).Value End With With Sheet2 arr1 = .Range("b8:D14").Value s = .Range("D4").Value For i = 3 To UBound(arr, 1) If arr(i, 1) = Empty Then arr(i, 1) = arr(i - 1, 1) For j = 6 To 12 If arr(i, j) <> Empty Then dk = arr(i, 1) & "#" & arr(1, j) If dic.exists(dk) = 0 Then If arr(i, 2) = s2 Then m = arr(i, j) Else m = arr(i, 2) & " = " & arr(i, j) End If dic.Item(dk) = Array(m) Else s = dic.Item(dk)(0) If arr(i, 2) = s2 Then s = s & " va " & arr(i, j) Else s = s & " va " & arr(i, 2) & " = " & arr(i, j) End If dic.Item(dk) = Array(s) End If End If Next j Next i For i = 1 To 7 s1 = .Range("D4").Value dk = s1 & "#" & arr1(i, 2) If dic.exists(dk) Then arr1(i, 3) = dic.Item(dk)(0) Else arr1(i, 3) = Empty End If Next i .Range("B8:d14").Value = arr1 End With End Sub