Public Dic As Object
Sub DienDG()
Dim pList, sArray, tmp1 As String, tmp2 As Double, i As Long, j As Long
On Error Resume Next
If Dic Is Nothing Then
Set Dic = CreateObject("Scripting.Dictionary")
pList = Sheet1.Range("A2:B1000").Value
For i = 1 To UBound(pList, 1)
If pList(i, 1) <> "" Then
tmp1 = CStr(pList(i, 1))
tmp2 = CDbl(pList(i, 2))
If Not Dic.Exists(tmp1) Then Dic.Add tmp1, tmp2
End If
Next
End If
With Sheet2.Range("A2:E10000")
sArray = .Value
For i = 1 To UBound(sArray, 1)
If sArray(i, 1) <> "" Then
sArray(i, 4) = Dic.Item(CStr(sArray(i, 2)))
sArray(i, 5) = sArray(i, 3) * sArray(i, 4)
End If
Next
.Value = sArray
End With
End Sub
Item là phương thức của Dictionay nó dùng để truy xuất phần tử thứ item trong Keys của Dictionary, Cstr dùng để chuyển đổi số thành chuỗi mà dùng để so sánh trong VBA Code thôi ta không thể chuyển chúng thành chuỗi rồi gán xuống sheet dạng text được, tương tự CDbl chuyển chuỗi thành số vài lời cùng bạn
Mấy bạn ở trên đã nói về ý nghĩa của CStr và CDbl rồi.. tôi xin nói thêm tại sao phải dùng mấy "thằng" này
Dic.Add "a", 5
Dic.Add "b", 11
Dic.Add "c", 15
Dhn46 xin nộp bài (trong bài dùng 2 mảng trong đó có 1 mảng để lấy dữ liệu nguồn không biết có được chấp nhận hay không?)
Sub Gpe()
Dim i As Long, k As Long, Arr, ArrKq, Dic As Object
Arr = Range("B2:D" & Range("B65536").End(3).Row)
ReDim ArrKq(1 To UBound(Arr, 1), 1 To 2)
MsgBox UBound(Arr)
Set Dic = CreateObject("scripting.dictionary")
With Dic
For i = 1 To UBound(Arr, 1)
If Not .exists(Arr(i, 1)) Then
k = k + 1
.Add Arr(i, 1), k
ArrKq(k, 1) = Arr(i, 1)
ArrKq(k, 2) = Arr(i, 3)
Else
If ArrKq(.Item(Arr(i, 1)), 2) < Arr(i, 3) Then ArrKq(.Item(Arr(i, 1)), 2) = Arr(i, 3)
End If
Next
End With
[F2].Resize(UBound(ArrKq, 1), 2) = ArrKq
End SubSub Gpe()
Dim i As Long, k As Long, Arr, Dic As Object
Arr = Range("B2:D" & Range("B65536").End(3).Row)
Set Dic = CreateObject("scripting.dictionary")
With Dic
For i = 1 To UBound(Arr, 1)
If Not .exists(Arr(i, 1)) Then
k = k + 1
.Add Arr(i, 1), k
Arr(k, 1) = Arr(i, 1)
Arr(k, 2) = Arr(i, 3)
Else
If Arr(.Item(Arr(i, 1)), 2) < Arr(i, 3) Then Arr(.Item(Arr(i, 1)), 2) = Arr(i, 3)
End If
Next
End With
[F2].Resize(k, 2) = Arr
End Sub
Thất nghiệp, Làm thử cái này xem sao.
Dim Dic As Object, Arr(), I As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
Arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value
For I = 1 To UBound(Arr, 1)
Tem = Arr(I, 1)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, Arr(I, 3)
Else
If Dic.Item(Tem) < Arr(I, 3) Then Dic.Item(Tem) = Arr(I, 3)
End If
Next I
With Application.WorksheetFunction
[F2].Resize(K).Value = .Transpose(Dic.Keys)
[G2].Resize(K).Value = .Transpose(Dic.Items)
End With
Set Dic = Nothing
End Sub
Mình nói rồi chẳng có gì khó cả. Nếu khó quá thì bỏ chạy vậy thôi
Sub vuivuivui()
Dim Arr(), I As Long, Tem As String
Arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value
With CreateObject("Scripting.Dictionary")
For I = 1 To UBound(Arr, 1)
Tem = Arr(I, 1)
If Error = 0 Then
Dic.Add Tem, Arr(I, 3)
Else
If .Item(Tem) < Arr(I, 3) Then .Item(Tem) = Arr(I, 3)
End If
Next I
[F2].Resize(.Count).Value = Application.Transpose(.Keys)
[G2].Resize(.Count).Value = Application.Transpose(.Items)
End With
End Sub
