Bạn hiểu đúng rồi đó.
Sub UniqueAndSum(sArray, ArrCols, UniqueCol, ArrSumCols)
...
End SubSub Test()
Sheet2.Range("G1:K100").ClearContents
Arr1 = Sheet1.Range("A2:G50001").Value
UniqueAndSum Arr1, Array(2, 1, 0, 4, 0, 7, 6), 2, Array(6, 7)
End Sub
Sub KiemTraTenSheet()
Dim SheetArr, Item As Variant
SheetArr = Array("Time", "Data", "Cot", "Dam")
For Each Item In SheetArr
If SheetExist(Item) = False Then MsgBox "Sheet " & Item & " khong ton tai"
Next
MsgBox "Da kiem tra xong"
End SubFunction SheetExist(ByVal WorkSheetName As String) As Boolean
On Error Resume Next
SheetExist = Not Sheets(WorkSheetName) Is Nothing
End FunctionSub Filter(sArray As Range)
Dim SubArr, Tmp
Set Dic = CreateObject("Scripting.Dictionary")
SubArr = sArray
For Each Tmp In SubArr
If Tmp <> "" And Not Dic.Exists(Tmp) Then
Dic.Add Tmp, ""
End If
Next
End SubSub Main()
ReDim Arr(1 To UBound(Dic.Keys, 1), 1 To 1)
sArray = Sheet1.Range("A1:B1000")
Call Filter
Arr = Dic.Keys
Sheets("sheet2").[A1].Resize(UBound(Dic.Keys, 1)).Value = Arr
End Sub
Public Dic
Sub Filter(sArray As String)
Dim SubArr, Tmp
Set Dic = CreateObject("Scripting.Dictionary")
SubArr = Sheets("sheet1").Range(sArray).Value
For Each Tmp In SubArr
If Tmp <> "" And Not Dic.Exists(Tmp) Then
Dic.Add Tmp, ""
End If
Next
End Sub
Sub Main()
Dim sArray As String
sArray = "A1:B1000"
Call Filter(sArray)
ReDim Arr(1 To UBound(Dic.Keys, 1), 1 To 1)
Arr = Dic.Keys
Sheets("sheet2").[A1].Resize(UBound(Dic.Keys, 1)).Value = WorksheetFunction.Transpose(Arr)
End Sub
Có thể là vầy cũng được:
Public Arr(), lR As Long
Sub Filter(ByVal SrcRng As Range)
Dim SubArr, tmpArr, Item, Dic As Object
On Error Resume Next
lR = 0
If SrcRng.Count = 1 Then
ReDim Arr(0)
Arr(0) = SrcRng.Value
lR = 1
Else
tmpArr = SrcRng.Value
ReDim Arr(1 To SrcRng.Rows.Count * SrcRng.Columns.Count, 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
For Each Item In tmpArr
If CStr(Item) <> "" Then
If Not Dic.Exists(CStr(Item)) Then
lR = lR + 1
Dic.Add CStr(Item), ""
Arr(lR, 1) = Item
End If
End If
Next
End If
End SubSub Main()
Dim SrcRng As Range
Set SrcRng = Sheet1.Range("A1:B1000")
Filter SrcRng
If lR Then Sheet2.Range("A1").Resize(lR).Value = Arr
End SubVì Dic.Keys là mảng 1 chiều, phải TRANSPOSE nó mới "lọt" đúng vào cột bảng tính (không TRANSPOSE nó sẽ "ngang" ra thành 1 dòng)
Có 2 loại byVal và byRef.
Bạn có thể bỏ Transpose với code của kyo sẽ thấy lý do tại sao phải Transpose. Ở đây, Transpose có nghĩa là đảo mảng qua 90 độ, tức là từ ngang thành dọc. Do mảng Dic là mảng ngang nên xuất ra dọc thì sẽ không được nên phải dùng Transpose.
Sub Filter(sArray As String)
Dim SubArr, Arr
If Sheets("Sheet1").Range(sArray).Count = 1 Then
ReDim Arr(0)
Arr(0) = Sheets("sheet1").Range(sArray).Value
GoTo Finish
End If
Set Dic = CreateObject("Scripting.Dictionary")
SubArr = Sheets("sheet1").Range(sArray).Value
ReDim Arr(1 To UBound(SubArr, 1) * UBound(SubArr, 2), 1 To 1)
For i = LBound(SubArr, 1) To UBound(SubArr, 1) * UBound(SubArr, 2)
If i > UBound(SubArr, 1) Then
If CStr(SubArr(i - UBound(SubArr, 1), 2)) <> "" And _
Not Dic.Exists(CStr(SubArr(i - UBound(SubArr, 1), 2))) Then
Dic.Add CStr(SubArr(i - UBound(SubArr, 1), 2)), ""
Arr(Dic.Count, 1) = SubArr(i - UBound(SubArr, 1), 2)
End If
Else
If CStr(SubArr(i, 1)) <> "" And Not Dic.Exists(CStr(SubArr(i, 1))) Then
Dic.Add CStr(SubArr(i, 1)), ""
Arr(Dic.Count, 1) = SubArr(i, 1)
End If
End If
Next
Finish:
Sheets("sheet2").[A1].Resize(UBound(Dic.Keys, 1) + 1).Value = Arr
End Sub
Sub Main()
Dim sArray As String
sArray = "A1:B1000"
Call Filter(sArray)
End SubBài đó làm rồi mà kyo, chẳng hạn là bài này:
