Option Explicit
Sub Main()
Dim sArr(), aCap(), aLK(), aDG(), res$(), sRow&, i&, j&
With Sheets("Data-v1")
sArr = .Range("B2", .Range("B999999").End(xlUp)).Value
End With
With Sheets("Requirement-v1")
aCap = .Range("A4", .Range("B999999").End(xlUp)).Value
aLK = .Range("C4", .Range("D999999").End(xlUp)).Value
aDG = .Range("E3:I3").Resize(.Range("F3").CurrentRegion.Rows.Count).Value
End With
For j = 1 To UBound(aDG, 2)
aDG(1, j) = "," & aDG(1, j) & ","
Next j
sRow = UBound(sArr)
ReDim res(1 To sRow, 1 To 1)
For i = 1 To sRow
res(i, 1) = MaLK(aCap, aLK, aDG, sArr(i, 1))
Next i
Sheets("Data-v1").Range("F2").Resize(sRow) = res
End Sub
Private Function MaLK(aCap, aLK, aDG, ByVal str As String) As String
Dim LK$, S, aUni, aUni2, tmp$, t$, N&, i&, j&, c&
For i = 1 To UBound(aLK)
If InStr(1, str, aLK(i, 1)) Then LK = aLK(i, 2): Exit For
Next i
aUni = Array("*#UH", "*#NH", "*#MH", "*#OHM")
aUni2 = Array("*#NF", "*#PF", "*#UF", "*#N")
S = Split(str, " ")
For c = 0 To UBound(S)
For j = 0 To UBound(aUni)
If S(c) Like aUni(j) Then
LK = "IND"
Exit For
ElseIf S(c) Like aUni2(j) Then
LK = "C"
Exit For
End If
Next j
Next c
If LK = Empty Then
For i = 1 To UBound(aLK)
If InStr(1, str, aLK(i, 1)) Then LK = aLK(i, 2): Exit For
Next i
End If
If LK = Empty Then LK = "???"
tmp = LK
If LK = "C" Then
For i = 1 To UBound(aCap)
If InStr(1, str, aCap(i, 1)) Then tmp = aCap(i, 2) & tmp: Exit For
Next i
End If
If LK = "IND" Then
aUni = Array("UH", "NH", "MH", "OHM")
For j = 0 To UBound(aUni)
N = InStr(1, str, aUni(j))
If N > 0 Then
S = Split(Mid(str, 1, N + 1), " ")
For c = 0 To UBound(S)
If InStr(1, S(c), aUni(j)) Then
If S(c) = aUni(j) Then
tmp = tmp & S(c - 1) & " " & S(c)
Else
tmp = tmp & S(c)
End If
tmp = Replace(tmp, "OHM", "R")
Exit For
End If
Next c
Exit For
End If
Next j
If j > UBound(aUni) Then tmp = tmp & "???" '***
ElseIf LK = "D" Then
S = Split(str, " ")
If InStr(1, S(UBound(S)), "(") = 0 Then tmp = tmp & S(UBound(S))
ElseIf LK = "C" Then
aUni = Array("*#NF", "*#PF", "*#UF", "*#N")
S = Split(str, " ")
For c = 0 To UBound(S)
For j = 0 To UBound(aUni)
If S(c) Like aUni(j) Then
tmp = tmp & S(c)
Exit For
End If
Next j
If j <= UBound(aUni) Then Exit For
Next c
If c > UBound(S) Then tmp = tmp & "???" '***
ElseIf LK = "R" Or LK = "FER" Or LK = "TMT" Then '***
aUni = Array("*#K", "*#KOHM", "*#M", "*#MOHM", "*#OHM")
aUni2 = Array("K", "KOHM", "M", "MOHM", "OHM")
S = Split(str, " ")
For c = 0 To UBound(S)
For j = 0 To UBound(aUni)
If S(c) Like aUni(j) Then
tmp = tmp & S(c)
Exit For
ElseIf S(c) = aUni2(j) Then
tmp = tmp & S(c - 1) & " " & S(c)
Exit For
End If
Next j
tmp = Replace(Replace(Replace(tmp, "KOHM", "K"), "MOHM", "M"), "OHM", "R")
If j <= UBound(aUni) Then Exit For
Next c
If c > UBound(S) Then tmp = tmp & "???" '***
ElseIf LK = "VAR" Then
S = Split(str, " ")
For c = 0 To UBound(S)
If S(c) Like "*#V" Then
tmp = tmp & S(c)
Exit For
End If
Next c
If c > UBound(S) Then tmp = tmp & "???" '***
ElseIf LK = "FUS" Then
S = Split(str, " ")
For c = 0 To UBound(S)
If S(c) Like "*#A" Then
tmp = tmp & S(c)
Exit For
End If
Next c
If c > UBound(S) Then tmp = tmp & "???" '***
ElseIf LK = "P" Then
S = Split(str, " ")
For c = 0 To UBound(S)
If S(c) Like "*#K" Then
tmp = tmp & S(c)
Exit For
End If
Next c
If c > UBound(S) Then tmp = tmp & "???" '***
End If
LK = "," & LK & ","
For j = 1 To UBound(aDG, 2)
If InStr(1, aDG(1, j), LK) Then
For i = 2 To UBound(aDG)
If InStr(1, str, aDG(i, j)) Then tmp = tmp & aDG(i, j): Exit For
Next i
If i <= UBound(aDG) Then Exit For
End If
Next j
MaLK = tmp
End Function[/CODE
[/QUOTE]
Em chào Anh HieuCD,
Anh cho em hỏi ba chỗ như hình được không ạ,
[ATTACH type="full"]273647[/ATTACH]
Chỗ này, mình có thể lấy IC như cột G được không Anh?
[ATTACH type="full"]273646[/ATTACH]
Đối với linh kiện Diode, dữ liệu bị trùng của phần đóng gói linh kiện,
[ATTACH type="full"]273648[/ATTACH]
Chỗ này, mình lấy là IC,
Tất cả tên đại diện,mình chỉ lấy phía ngoài cùng bên trái theo tên mình có để trong dữ liệu,
Nhờ Anh kiểm tra thêm cho em được không,
Cảm ơn Anh!.
