Sub Test()
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Dic.Add "a", "aa"
Dic.Add "b", "bb"
Dic.Add "c", "cc"
MsgBox TypeName(Dic.Item("[COLOR=#ff0000]d[/COLOR]"))
End Sub
Sub a()
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 IsNull(Dic.Item(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(Dic.Count).Value = .Transpose(Dic.keys)
[G2].Resize(Dic.Count).Value = .Transpose(Dic.Items)
End With
Set Dic = Nothing
End Sub
Sub vuivui()
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 IsEmpty(.Item(tem)) Then
.Item(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
Sub LocMax()
Dim r As Long, arr(), dic As Object
With ThisWorkbook.Worksheets("Sheet1")
.Range("F1", .Cells(.Rows.Count - 1, "G").End(xlUp)).Offset(1).Clear
arr = .Range("B2", .Cells(.Rows.Count, "D").End(xlUp)).Value
Set dic = CreateObject("Scripting.Dictionary")
For r = 1 To UBound(arr, 1)
If dic.Item(arr(r, 1)) = "" Then dic.Item(arr(r, 1)) = arr(r, 3)
If arr(r, 3) > dic.Item(arr(r, 1)) Then dic.Item(arr(r, 1)) = arr(r, 3)
Next
.Range("F2").Resize(dic.Count, 1).Value = Application.Transpose(dic.Keys)
.Range("G2").Resize(dic.Count, 1).Value = Application.Transpose(dic.Items)
.Range("F2:G11").Sort Key1:=.Range("F2"), Order1:=xlAscending, Header:=xlNo
End With
Set dic = Nothing
End SubSub Key_Remove()
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 Not IsEmpty(.Item(tem)) Then
If .Item(tem) < arr(i, 3) Then
.Remove tem
.Item(tem) = arr(i, 3)
End If
Else
.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 SubSub ConsolMAX()
Dim aData, sTmp As String
Dim lR As Long, n As Long, lMax As Double
aData = Sheet1.Range("B2:D60000").Value
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For lR = 1 To UBound(aData)
sTmp = CStr(aData(lR, 1))
If Len(sTmp) Then
If TypeName(.Item(sTmp)) = "Empty" Then
n = n + 1
.Item(sTmp) = n
aData(n, 1) = sTmp
aData(n, 2) = aData(lR, 3)
Else
lMax = aData(lR, 3)
If lMax > aData(.Item(sTmp), 2) Then aData(.Item(sTmp), 2) = lMax
End If
End If
Next
End With
If n Then
With Sheet1.Range("F2:G60000")
.ClearContents
.Resize(n, 2).Value = aData
End With
End If
End Sub
Bài này với "luật lệ" của bài này thì có gì "phạm quy" hông ta?
mảng aData hình như bị đọc và gán lại hơn một lần!
Cái này hình như là gán lại:
Híc!
Cũng như anh thanhlanh đã nói
nên em chỉ quan tâm đến giải thuật xử lý trong Dictionary thôi, còn mảng thế nào không quan trọng. Thậm chí nên thêm 1 Array kết quả nữa sẽ tường minh hơn
Tản mạn chút (rồi bị del cũng.. chịu)
Không cho xài Dic để lấy dữ liệu duy nhất thì xài mảng cũng xơi được. Cái macro4 gì đó mình không biết xài nên xử kiểu này thấy cũng đơn giản. Mình thuộc dạng liều mạng mà. Híc.
Sub loc_duy_nhat_lay_max_khong_dung_dic()
Dim arr(), i As Long, result(), j As Long, n As Long, m As Long
arr = Range([B2], [B65000].End(xlUp)).Resize(, 3).Value
ReDim result(1 To UBound(arr), 1 To 2)
For i = 1 To UBound(arr)
For j = 1 To UBound(result)
If arr(i, 1) = result(j, 1) Then
If result(j, 2) < arr(i, 3) Then result(j, 2) = arr(i, 3)
n = 0: Exit For
Else
n = n + 1
End If
Next j
If n Then
m = m + 1
result(m, 1) = arr(i, 1): result(m, 2) = arr(i, 3)
End If
Next
[H2].Resize(m, 2) = result
End Sub
