Thắc mắc về hàm UDF UniqueList (1 người xem)

[Hoàng Trọng Nghĩa]

Function UniqueList(ParamArray sArray())
  Dim Item, TmpArr, SubArr
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      TmpArr = SubArr
      If TypeName(TmpArr) <> "Variant()" Then
        If TmpArr <> "" Then .Add TmpArr, ""
      Else
        For Each Item In TmpArr
          If Item <> "" Then
            If Not .Exists(Item) Then .Add Item, ""
          End If
        Next
      End If
    Next
    UniqueList = .Keys
  End With
End Function

Nếu làm từ AdvancedFilter thì không nói gì:

Sub TEST2()
  With Range([A2], [A65536].End(xlUp))
    .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    .Resize(, 7).Copy [J17]
  End With
  ActiveSheet.ShowAllData
End Sub

nhưng làm theo hàm UniqueList của Thầy ndu96081631 thì không thể thực hiện được.

Tôi làm thủ tục như sau:

Sub TEST()
  Dim Arr1
  With Range([A3], [A65536].End(xlUp)).Resize(, 7)
    Arr1 = UniqueList(.Cells)
    [J17].Resize(UBound(Arr1, 1), 7).Value = WorksheetFunction.Transpose(Arr1)
  End With
End Sub

Kết quả ra hoàn toàn không như ý.

Xin hướng dẫn thủ tục sử dụng hàm này cho đúng.

Cám ơn rất nhiều!

 

[ptm0412]

Không như ý đúng rồi.
Nên nghiên cứu lại Scripting Dictionary:
Dictionary chỉ cho ra kết quả là 1 mảng 1 chiều, chứ không thể cho 1 mảng 2 chiều.
Do đó đầu vào chỉ có thể là mảng 1 chiều (1 cột cần lấy ra DS duy nhất), dùng parameter cũng chỉ là tập hợp nhiều mảng 1 chiều đó, chứ không phải 2 chiều
Code của MinhThien dùng UniqueList cho đầu vào là mảng 2 chiều nên ra kết quả sai:
UniqueList() sẽ lấy DS duy nhất từ cả 7 cột nhập thành 1 mảng 1 chiều. Gán kết quả cho 7 cột thì là 7 kết quả giống nhau chứ không phải 1 kết quả.

 

[Hoàng Trọng Nghĩa]

Không như ý đúng rồi.
Nên nghiên cứu lại Scripting Dictionary:
Dictionary chỉ cho ra kết quả là 1 mảng 1 chiều, chứ không thể cho 1 mảng 2 chiều.
Do đó đầu vào chỉ có thể là mảng 1 chiều (1 cột cần lấy ra DS duy nhất), dùng parameter cũng chỉ là tập hợp nhiều mảng 1 chiều đó, chứ không phải 2 chiều
Code của MinhThien dùng UniqueList cho đầu vào là mảng 2 chiều nên ra kết quả sai:
UniqueList() sẽ lấy DS duy nhất từ cả 7 cột nhập thành 1 mảng 1 chiều. Gán kết quả cho 7 cột thì là 7 kết quả giống nhau chứ không phải 1 kết quả.

Như vậy thì Sư phụ có cao kiến gì không? Chứ về các hàm mãng em hơi dốt, đang cố nghiên cứu mà chưa thấy tiến bộ, càng nghiên cứu càng thấy ngu ngu.

 

[ptm0412]

Đã bảo là nghiên cứu về Dictionary.
Hướng là dùng Dictionary tạo DS duy nhất cho cột A
dùng thêm 1 mảng 7 cột đồng thời với Dic:
Khi điều kiện duy nhất (dựa vào Dic.Exist ...) thỏa, add 1 item vào Dic, đồng thời add toàn bộ dòng dữ liệu thỏa đk đó vào mảng.

Xem thêm: http://www.giaiphapexcel.com/forum/showthread.php?42791-Nhờ-hướng-dẫn-sử-dụng-Dictionary-Object.&

 

[Hoàng Trọng Nghĩa]

Đã bảo là nghiên cứu về Dictionary.
Hướng là dùng Dictionary tạo DS duy nhất cho cột A
dùng thêm 1 mảng 7 cột đồng thời với Dic:
Khi điều kiện duy nhất (dựa vào Dic.Exist ...) thỏa, add 1 item vào Dic, đồng thời add toàn bộ dòng dữ liệu thỏa đk đó vào mảng.

Xem thêm: http://www.giaiphapexcel.com/forum/showthread.php?42791-Nhờ-hướng-dẫn-sử-dụng-Dictionary-Object.&

Thiệt tình mà nói thì nhờ các Thầy hướng dẫn để áp dụng, chứ nghiên cứu cái Dic này em ăn không ngon ngủ không yên cả tuần nay rồi, càng làm, nó càng trừu tượng, làm cái này nó ra cái kia, chưa được cái nào ra hồn hết. Nên nhờ các Thầy chỉ đường trước rồi lần đường sau, chứ coi bài đó từ cái buổi Sư phụ dời bài đến nay vẫn chưa hiểu gì hết đó, không thể hình dung ra nhiều. Hic hic.

 

[ndu96081631]

Thiệt tình mà nói thì nhờ các Thầy hướng dẫn để áp dụng, chứ nghiên cứu cái Dic này em ăn không ngon ngủ không yên cả tuần nay rồi, càng làm, nó càng trừu tượng, làm cái này nó ra cái kia, chưa được cái nào ra hồn hết. Nên nhờ các Thầy chỉ đường trước rồi lần đường sau, chứ coi bài đó từ cái buổi Sư phụ dời bài đến nay vẫn chưa hiểu gì hết đó, không thể hình dung ra nhiều. Hic hic.

Dễ lắm... làm theo giải thuật sau:
- Duyệt Range theo dòng (từ A3 xuống)
- Add vào Dic nếu nó chưa tồn tại trong Dic... Đồng thời duyệt ngang qua theo cột, cho mọi thứ vào mảng 2 chiều
- Tiếp tục công việc trên, đến cuối cùng thì xuất kết quả
---------------------
Cứ tự mình làm trước đi, đến đâu sẽ tính đến đấy ----> Tôi nghĩ giải thuật này không quá khó hiểu đối với bạn đâu

 

[Hoàng Trọng Nghĩa]

Dễ lắm... làm theo giải thuật sau:
- Duyệt Range theo dòng (từ A3 xuống)
- Add vào Dic nếu nó chưa tồn tại trong Dic... Đồng thời duyệt ngang qua theo cột, cho mọi thứ vào mảng 2 chiều
- Tiếp tục công việc trên, đến cuối cùng thì xuất kết quả
---------------------
Cứ tự mình làm trước đi, đến đâu sẽ tính đến đấy ----> Tôi nghĩ giải thuật này không quá khó hiểu đối với bạn đâu

Nhưng cho em hỏi là có dùng hàm của Thầy để tính không? Bởi em đang "bơi ngược dòng" nên chẳng thấy bờ bến đâu hết. Có lẽ phải mất một thời gian để hiểu về nó thì mới làm được. Chứ học ngang xương như vầy không thể hiểu tường tận được.

 

[ptm0412]

Nhưng cho em hỏi là có dùng hàm của Thầy để tính không?

Do hàm UniqueList() lấy DS duy nhất từ nguyên 1 Range (hoặc nhiều Range), chứ không phải lấy DS duy nhất từ 1 cột trong Range, nên dứt khoát không dùng được. Phải dùng Dic như trong link bài trên

 

[Hoàng Trọng Nghĩa]

Do hàm UniqueList() lấy DS duy nhất từ nguyên 1 Range (hoặc nhiều Range), chứ không phải lấy DS duy nhất từ 1 cột trong Range, nên dứt khoát không dùng được. Phải dùng Dic như trong link bài trên

Như vậy là mình phải làm những thủ tục nhỏ lẻ cho các trường hợp cụ thể, chứ không làm tổng quát thành một hàm được phải không thưa Thầy? Em chưa nhận thức được về Dic nhiều, nhưng lại muốn tổng quát, thiệt là "chưa học bò đã học chạy".

 

[ndu96081631]

Như vậy là mình phải làm những thủ tục nhỏ lẻ cho các trường hợp cụ thể, chứ không làm tổng quát thành một hàm được phải không thưa Thầy? Em chưa nhận thức được về Dic nhiều, nhưng lại muốn tổng quát, thiệt là "chưa học bò đã học chạy".

Xin thưa: Tổng quát thành 1 hàm được luôn (tùy ý bạn muốn hàm ấy làm điều gì)

 

[Hoàng Trọng Nghĩa]

Xin thưa: Tổng quát thành 1 hàm được luôn (tùy ý bạn muốn hàm ấy làm điều gì)

Vậy nhờ Thầy giúp em luôn đi ạ! Nhưng em có cảm giác nếu trên 65536 dòng (dùng trong X2007) thì cái Scripting.Dictionary này nó chạy muốn đứng lại rất lâu cho lần đầu tiên sử dụng.

Thầy làm ơn làm hàm tổng quát giúp em đi ạ. Em mà tự làm chắc mất nửa năm!

Cám ơn Thầy nhiều.

 

[ndu96081631]

Vậy nhờ Thầy giúp em luôn đi ạ! Nhưng em có cảm giác nếu trên 65536 dòng (dùng trong X2007) thì cái Scripting.Dictionary này nó chạy muốn đứng lại rất lâu cho lần đầu tiên sử dụng.

Thầy làm ơn làm hàm tổng quát giúp em đi ạ. Em mà tự làm chắc mất nửa năm!

Cám ơn Thầy nhiều.

Vầy đi: Dữ liệu của bạn nhiều bao nhiêu? Đưa lên đây tôi test luôn (tôi không có file giả lập nhiều dòng như vậy)

 

[Hoàng Trọng Nghĩa]

Vầy đi: Dữ liệu của bạn nhiều bao nhiêu? Đưa lên đây tôi test luôn (tôi không có file giả lập nhiều dòng như vậy)

Vừa qua em làm thử trên File RÚT THĂM TRÚNG THƯỞNG mà em đã gửi tặng mọi người theo nguồn của Thầy đó, em thử 10000 số để nó random thế là nó ì ạch ra nên em giới hạn chỉ 999 số thôi đó Thầy.

http://www.giaiphapexcel.com/forum/showthread.php?51196-Tặng-các-bạn-file-QUAY-SỐ-TRÚNG-THƯỞNG-nhân-dịp-SN-GiaiphapExcel.Com-lần-5&p=323317#post323317

Nhưng đó là hỏi thêm thôi, cái chính vẫn là muốn nhờ Thầy làm cho em cái Hàm tổng quát Unique đó ạ.

 

[ptm0412]

Sau đây là 1 hàm lọc DS duy nhất thành 1 bảng 2D. Đã tuỳ biến lấy danh sách duy nhất theo cột thứ mấy trong range nguồn.

Function UniqueList2D(UniqueCol As Long, sArray)
  Dim ReArr
  Dim iRw, iRws, iCols, iCol, iCount
  iRws = UBound(sArray, 1)
  iCols = UBound(sArray, 2)
  ReDim ReArr(1 To iRws, 1 To iCols)
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
        For iRw = 1 To iRws
          If sArray(iRw, UniqueCol) <> "" Then
            If Not .Exists(sArray(iRw, UniqueCol)) Then
                .Add sArray(iRw, UniqueCol), ""
                iCount = iCount + 1
                For iCol = 1 To iCols
                   ReArr(iCount, iCol) = sArray(iRw, iCol)
                Next
            End If
          End If
    Next
    UniqueList2D = ReArr
  End With
End Function

Còn đây là code Test lấy kết quả theo danh sách duy nhất cột 1. Hãy thử với cột 2, hoặc cột bất kỳ.

Sub TEST()
  Dim Arr1, Arr2
  With Range([A3], [A65536].End(xlUp)).Resize(, 7)
    Arr1 = .Cells
    Arr2 = UniqueList2D(1, Arr1)
    [J2].Resize(UBound(Arr2, 1), 7).Value = Arr2
  End With
End Sub

 

[Hoàng Trọng Nghĩa]

Sau đây là 1 hàm lọc DS duy nhất thành 1 bảng 2D. Đã tuỳ biến lấy danh sách duy nhất theo cột thứ mấy trong range nguồn.

Function UniqueList2D(UniqueCol As Long, sArray)
  Dim Item, TmpArr, SubArr, ReArr
  Dim iRw, iRws, iCols, iCol, iCount
  iRws = UBound(sArray, 1)
  iCols = UBound(sArray, 2)
  ReDim ReArr(1 To iRws, 1 To iCols)
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
        For iRw = 1 To iRws
          If sArray(iRw, UniqueCol) <> "" Then
            If Not .Exists(sArray(iRw, UniqueCol)) Then
                .Add sArray(iRw, UniqueCol), ""
                iCount = iCount + 1
                For iCol = 1 To iCols
                   ReArr(iCount, iCol) = sArray(iRw, iCol)
                Next
            End If
          End If
    Next
    UniqueList2D = ReArr
  End With
End Function

Còn đây là code Test lấy kết quả theo danh sách duy nhất cột 1. Hãy thử với cột 2, hoặc cột bất kỳ.

Sub TEST()
  Dim Arr1, Arr2
  With Range([A3], [A65536].End(xlUp)).Resize(, 7)
    Arr1 = .Cells
    Arr2 = UniqueList2D(1, Arr1)
    [J2].Resize(UBound(Arr2, 1), 7).Value = Arr2
  End With
End Sub

Trời ơi, tuyệt cú mèo, em thử đão cột mã số lên đầu (sợ nó chê số) nhưng vẫn hoạt động cực kỳ nhanh! Cám ơn Sư phụ nhiều nhiều. Thế là em có thêm nhiều thứ để ứng dụng Hàm này đây! Cám ơn Sư phụ!

 

[ptm0412]

Ẹc, để nguyên cột mã số ở cột 2, nhưng trong sub Test dùng:
Arr2 = UniqueList2D(2, Arr1)

Và thử thay chuyển cột Mã số sang cột D và thay số đỏ bằng số 4 xem?

Nhưng chưa nhanh hết mức đâu, để ndu vô xài Redim Preserve sẽ thấy nhanh gấp đôi.

 

[Hoàng Trọng Nghĩa]

Ẹc, để nguyên cột mã số ở cột 2, nhưng trong sub Test dùng:
Arr2 = UniqueList2D(2, Arr1)

Và thử thay chuyển cột Mã số sang cột D và thay số đỏ bằng số 4 xem?

Em đã thử và thấy không có gì thay đổi, ý của Sư phụ là gì vậy?

À, em hiểu rồi, cái số màu đỏ là cột cần lọc duy nhất, không cần phải là cột đầu tiên! Tiện ích quá!

 

[ptm0412]

Nghĩa là không cần chuyển cột mã số từ cột B sang cột A, mà thay tham số UniqueCol của hàm từ 1 thành 2, tham số đó là số thứ tự của cột cần lọc duy nhất (như advanced filter).

Dĩ nhiên là không thay đổi, chỉ cần thay tham số, không cần di chuyển cột, mà kết quả giống y mới là hay chứ.

Buồn buồn không muốn lọc duy nhất theo cột mã hay cột tên, mà lọc duy nhất theo cột Phatsinh4 cũng được như thường. (tham số UniqueCol = 7)

 

[ptm0412]

Cải tiến bằng ReDim Preserve. Thử với 50 ngàn dòng trở lên mới thấy khác biệt về tốc độ so với code cũ. Nhất là 50 ngàn dòng dữ liệu mà chỉ có rất ít mã duy nhất (100 mã chẳng hạn).
Ngoài ra, lại còn tiết kiệm bộ nhớ là một, kết quả gán xuống sheet không bị dư là 2. (Code cũ dù chỉ 8 mã duy nhất nhưng gán xuống sheet 32 dòng, còn code mới gán xuống vừa đúng 8 dòng)

Function UniqueList2D(UniqueCol As Long, sArray)
  Dim ReArr()
  Dim iRw, iRws, iCols, iCol, iCount
  iRws = UBound(sArray, 1)
  iCols = UBound(sArray, 2)
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
        For iRw = 1 To iRws
          If sArray(iRw, UniqueCol) <> "" Then
            If Not .Exists(sArray(iRw, UniqueCol)) Then
                .Add sArray(iRw, UniqueCol), ""
                iCount = iCount + 1
                ReDim Preserve ReArr(1 To iCols, 1 To iCount)
                For iCol = 1 To iCols
                   ReArr(iCol, iCount) = sArray(iRw, iCol)
                Next
            End If
          End If
    Next
    UniqueList2D = Application.Transpose(ReArr)
  End With
End Function

 

[Hoàng Trọng Nghĩa]

Cải tiến bằng ReDim Preserve. Thử với 50 ngàn dòng trở lên mới thấy khác biệt về tốc độ so với code cũ. Nhất là 50 ngàn dòng dữ liệu mà chỉ có rất ít mã duy nhất (100 mã chẳng hạn).
Ngoài ra, lại còn tiết kiệm bộ nhớ là một, kết quả gán xuống sheet không bị dư là 2. (Code cũ dù chỉ 8 mã duy nhất nhưng gán xuống sheet 32 dòng, còn code mới gán xuống vừa đúng 8 dòng)

Function UniqueList2D(UniqueCol As Long, sArray)
  Dim ReArr()
  Dim iRw, iRws, iCols, iCol, iCount
  iRws = UBound(sArray, 1)
  iCols = UBound(sArray, 2)
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
        For iRw = 1 To iRws
          If sArray(iRw, UniqueCol) <> "" Then
            If Not .Exists(sArray(iRw, UniqueCol)) Then
                .Add sArray(iRw, UniqueCol), ""
                iCount = iCount + 1
                ReDim Preserve ReArr(1 To iCols, 1 To iCount)
                For iCol = 1 To iCols
                   ReArr(iCol, iCount) = sArray(iRw, iCol)
                Next
            End If
          End If
    Next
    UniqueList2D = Application.Transpose(ReArr)
  End With
End Function

Đúng là "Không Thầy đố mày làm nên" mà! Trong vòng tiếng đồng hồ đã làm và cải tiến Hàm này, thật là quá sức tưởng tượng đối với em. Trước mắt em sẽ ứng dụng mà chưa cần nghĩ bản chất của nó như thế nào, nhưng em sẽ cố gắng nghiên cứu kỹ về nó hiểu và tự sử dụng nó.

Cám ơn Sư phụ PTM rất nhiều!

 

[ndu96081631]

Xét về thuật toán thì bài này không khó. Cái khó là:
- Viết thành 1 UDF tổng quát
- Cho phép hoạt động trên mọi Array (Base 0 hoặc Base 1)
- Có thể gõ trực tiếp vào bảng tính như 1 hàm của Excel
-------------------------
"Bắt chước" y chang cách viết của hàm Filter2DArray:

Function Unique2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal HasTitle As Boolean)
  Dim TmpArr, KeyArr, Tmp, i As Long, j As Long, Arr
  On Error Resume Next
  TmpArr = sArray
  ColIndex = ColIndex + LBound(TmpArr, 2) - 1
  With CreateObject("Scripting.Dictionary")
    For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
      Tmp = TmpArr(i, ColIndex)
      If Not .Exists(Tmp) And Tmp <> "" Then .Add Tmp, i
    Next
    If .Count Then
      KeyArr = .Keys
      ReDim Arr(LBound(KeyArr) + LBound(TmpArr, 1) To UBound(KeyArr) - HasTitle + LBound(TmpArr, 1), LBound(TmpArr, 2) To UBound(TmpArr, 2))
      For i = LBound(KeyArr) To UBound(KeyArr)
        For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
          Arr(i - HasTitle + LBound(TmpArr, 1), j) = TmpArr(.Item(KeyArr(i)), j)
        Next
      Next
      If HasTitle Then
        For j = LBound(TmpArr, 2) To UBound(TmpArr, 2)
          Arr(LBound(TmpArr, 1), j) = TmpArr(LBound(TmpArr, 1), j)
        Next
      End If
      Unique2DArray = Arr
    End If
  End With
End Function

Sư phụ ptm0412 dùng TRANSPOSE nên sẽ có lỗi xảy ra trong 1 số trường hợp, còn code ở trên thêm 1 vòng lập nữa để lấy kết quả duy nhất trước, sau đó mới nạp vào Array kết quả (không dùng TRANSPOSE) nên chắc chắn sẽ không có bất cứ lỗi nào
Ngoài ra, code ở trên còn cho phép bạn tùy chọn dữ liệu là CÓ TIÊU ĐỀ HOẶC KHÔNG CÓ TIÊU ĐỀ
Ví dụ code trích lọc không lấy tiêu đề:

Sub Test2()
  Dim sArray, Arr, TG As Double
  TG = Timer
  sArray = Range(Sheet1.[A3], Sheet1.[A65536].End(xlUp)).Resize(, 7)
  Arr = Unique2DArray(sArray, 1, [COLOR=#ff0000][B]FALSE[/B][/COLOR])
  If IsArray(Arr) Then Sheet1.Range("J2").Resize(UBound(Arr, 1), 7).Value = Arr
  MsgBox Format(Timer - TG, "0.000000")
End Sub

Và code trích lọc lấy luôn tiêu đề:

Sub Test2()
  Dim sArray, Arr, TG As Double
  TG = Timer
  sArray = Range(Sheet1.[A2], Sheet1.[A65536].End(xlUp)).Resize(, 7)
  Arr = Unique2DArray(sArray, 1, [COLOR=#ff0000][B]TRUE[/B][/COLOR])
  If IsArray(Arr) Then Sheet1.Range("J1").Resize(UBound(Arr, 1), 7).Value = Arr
  MsgBox Format(Timer - TG, "0.000000")
End Sub

Đã thử nghiệm với dữ liệu 40,000 dòng, ra kết quả trong khoảng 1s

 

[Hoàng Trọng Nghĩa]

Xin cảm ơn Thầy NDU rất nhiều, Thầy và Sư phụ PTM thật nhiệt tình và kiến thức thật uyên thâm. Bản thân em tư duy về mãng còn hạn chế quá nên không thấy phát huy được tí nào hết. Thôi đành ứng dụng của các Thầy vậy (chứ ứng dụng của mình chắc chạy cả phút mới ra kết quả, mà chưa chắc đã là đúng nữa!)

Xin cảm ơn 2 Thầy đã hướng dẫn ạ!

 

[vodoi2x]

Xin cảm ơn Thầy NDU rất nhiều, Thầy và Sư phụ PTM thật nhiệt tình và kiến thức thật uyên thâm. Bản thân em tư duy về mãng còn hạn chế quá nên không thấy phát huy được tí nào hết. Thôi đành ứng dụng của các Thầy vậy (chứ ứng dụng của mình chắc chạy cả phút mới ra kết quả, mà chưa chắc đã là đúng nữa!)

Xin cảm ơn 2 Thầy đã hướng dẫn ạ!

Chú ý tôi thử thấy cả 2 cái trên của ndu và ptm đều hoạt động sai khác so với Advance filter unique only nhé

Advance filter cho phép lọc duy nhất cho cả hàng (unique records)

Còn Các Sub / Function trên chỉ lọc duy nhất cho 1 cột và copy các cột đi theo,

bạn phải xem lại cận thận phạm vi ứng dụng?

 

[ndu96081631]

Chú ý tôi thử thấy cả 2 cái trên của ndu và ptm đều hoạt động sai khác so với Advance filter unique only nhé

Advance filter cho phép lọc duy nhất cho cả hàng (unique records)

Còn Các Sub / Function trên chỉ lọc duy nhất cho 1 cột và copy các cột đi theo,

bạn phải xem lại cận thận phạm vi ứng dụng?

Thì người ta yêu cầu như vậy cơ mà
Còn muốn Unique nguyên hàng thì... cũng chẳng khó tí nào (gần như y chang vậy)
Tóm lại là: VIẾT CODE THEO YÊU CẦU CỦA NGƯỜI DÙNG

 

[ptm0412]

Chú ý tôi thử thấy cả 2 cái trên của ndu và ptm đều hoạt động sai khác so với Advance filter unique only nhé

Advance filter cho phép lọc duy nhất cho cả hàng (unique records)

Còn Các Sub / Function trên chỉ lọc duy nhất cho 1 cột và copy các cột đi theo,

bạn phải xem lại cận thận phạm vi ứng dụng?

Phạm vi ứng dụng thì xem trong file yêu cầu bài 1:
Lọc DS duy nhất 1 cột và các cột khác đi theo.
Advanced Filter tác giả đã thực hiện cũng chỉ 1 cột.

 

[Hoàng Trọng Nghĩa]

Chú ý tôi thử thấy cả 2 cái trên của ndu và ptm đều hoạt động sai khác so với Advance filter unique only nhé

Advance filter cho phép lọc duy nhất cho cả hàng (unique records)

Còn Các Sub / Function trên chỉ lọc duy nhất cho 1 cột và copy các cột đi theo,

bạn phải xem lại cận thận phạm vi ứng dụng?

Không đâu, trong Excel nó cũng Unique tại cột 1 thôi, các số liệu khác ăn theo cái cột đã unique. Cái này em đã kiểm tra rồi ạ.

Các hàm tự tạo vừa rồi hay hơn thằng Excel đấy chứ! Vã lại nếu mỗi cái mỗi Unique thì chết! Lộn xộn mất thôi.

 

[vodoi2x]

Không đâu, trong Excel nó cũng Unique tại cột 1 thôi, các số liệu khác ăn theo cái cột đã unique. Cái này em đã kiểm tra rồi ạ.

Các hàm tự tạo vừa rồi hay hơn thằng Excel đấy chứ! Vã lại nếu mỗi cái mỗi Unique thì chết! Lộn xộn mất thôi.

Không phải, đó là trường hợp bạn chưa lấy số liệu sự khác biệt đó

Advanced Fillter cho phép Records only -- tức là duy nhất cho tất cả các cột (bạn thử lại với trường hợp các dòng có cột 1 mã giống nhau (chẳng hạn) nhưng các cột khác khác nhau, thì sẽ thấy rõ ngay.
Không phải, đó là trường hợp bạn chưa lấy số liệu sự khác biệt đó

 

[ndu96081631]

Không đâu, trong Excel nó cũng Unique tại cột 1 thôi, các số liệu khác ăn theo cái cột đã unique. Cái này em đã kiểm tra rồi ạ.

Các hàm tự tạo vừa rồi hay hơn thằng Excel đấy chứ! Vã lại nếu mỗi cái mỗi Unique thì chết! Lộn xộn mất thôi.

1 cột hay nhiều cột là do bạn quét chọn List Range thôi
- Quét chọn List Range là 1 cột thì nó Unique 1 cột
- Quét chọn List Range nhiều cột thì nó Unique nhiều cột

 

[Hoàng Trọng Nghĩa]

Không biết có thể cải tiến ngoài việc chọn Resize giới hạn số cột khi copy, có thể Offset mãng trong Dic được không? Bởi mỗi lần mình giới hạn (bỏ qua) cột nào đó thì cột kế tiếp để copy mình lại sử dụng Hàm lại. Tương tự với Filter2DArray. Tức là copy bất kỳ cột nào trong mãng chứ không phải là từ trái qua phải.

 

[ptm0412]

Sư phụ ptm0412 dùng TRANSPOSE nên sẽ có lỗi xảy ra trong 1 số trường hợp, còn code ở trên thêm 1 vòng lập nữa để lấy kết quả duy nhất trước, sau đó mới nạp vào Array kết quả (không dùng TRANSPOSE) nên chắc chắn sẽ không có bất cứ lỗi nào

Cho tới giờ vẫn chưa tìm ra trường hợp lỗi nào của Transpose, kể cả test với 50 ngàn dòng mà chỉ 10 Unique Name.

code ở trên còn cho phép bạn tùy chọn dữ liệu là CÓ TIÊU ĐỀ HOẶC KHÔNG CÓ TIÊU ĐỀ

Tham số này không cần thiết, vì thông thường dữ liệu không trùng với tiêu đề. Vậy bản thân tiêu đề cũng là 1 trong danh sách không trùng. Chỉ cần trùm luôn dòng tiêu đề vào range sArray là xong.

 

[ndu96081631]

Cho tới giờ vẫn chưa tìm ra trường hợp lỗi nào của Transpose, kể cả test với 50 ngàn dòng mà chỉ 10 Unique Name.

Cái này có đấy sư phụ à (em đã từng gặp)
Sư phụ có thể search google sẽ thấy rất nhiều người hỏi về vấn đề giới hạn của TRANSPOSE

Tham số này không cần thiết, vì thông thường dữ liệu không trùng với tiêu đề. Vậy bản thân tiêu đề cũng là 1 trong danh sách không trùng. Chỉ cần trùm luôn dòng tiêu đề vào range sArray là xong.

Cần chứ sư phụ
Chẳng hạn có người ta dùng Number để làm tiêu đề... Vậy trong phần nội dung sẽ không chắc dữ liệu sẽ luôn không trùng với tiêu đề (cũng vì thế mà chức năng Remove Duplicate của Excel 2007 cho phép người dùng chọn có tiêu đề hay không)
---------------------------

Không biết có thể cải tiến ngoài việc chọn Resize giới hạn số cột khi copy, có thể Offset mãng trong Dic được không? Bởi mỗi lần mình giới hạn (bỏ qua) cột nào đó thì cột kế tiếp để copy mình lại sử dụng Hàm lại. Tương tự với Filter2DArray. Tức là copy bất kỳ cột nào trong mãng chứ không phải là từ trái qua phải.

Nêu 1 ví dụ cụ thể, vì tôi không hiểu bạn nói gì cả

 

[ptm0412]

Cái này có đấy sư phụ à (em đã từng gặp)
Sư phụ có thể search google sẽ thấy rất nhiều người hỏi về vấn đề giới hạn của TRANSPOSE

Có thể, nếu tích số số dòng nhân số cột, hoặc số cột vượt quá 1 giá trị giới hạn nào đó.

Cần chứ sư phụ
Chẳng hạn có người ta dùng Number để làm tiêu đề... Vậy trong phần nội dung sẽ không chắc dữ liệu sẽ luôn không trùng với tiêu đề (cũng vì thế mà chức năng Remove Duplicate của Excel 2007 cho phép người dùng chọn có tiêu đề hay không)

Ẹc ẹc, dùng Number làm tiêu đề là không đúng chuẩn CSDL. Kể cả vẽ đồ thị cũng bị lỗi huống chi làm việc khác.

Nêu 1 ví dụ cụ thể, vì tôi không hiểu bạn nói gì cả

Đại khái là sArray 7 cột, nhưng chỉ lấy kết quả 3 cột 1, 3 và 6. Và thứ tự không giống ban đầu chẳng hạn 1, 6, 3. Chuyện này nằm trong tầm tay.

To MinhThien:
Dic không phải là mảng đơn thuần, nó chỉ có 1 chiều. Không thể resize. Cái ta resize là mảng nguồn và mảng song song với Dic.
Và kể cả mảng thông thường, không có khái niệm Offset mảng.

 

[ndu96081631]

Đại khái là sArray 7 cột, nhưng chỉ lấy kết quả 3 cột 1, 3 và 6. Và thứ tự không giống ban đầu chẳng hạn 1, 6, 3. Chuyện này nằm trong tầm tay.
To MinhThien:
Dic không phải là mảng đơn thuần, nó chỉ có 1 chiều. Không thể resize. Cái ta resize là mảng nguồn và mảng song song với Dic.
Và kể cả mảng thông thường, không có khái niệm Offset mảng.

Vậy dễ nhất là cứ làm bình thường, ra được mảng kết quả, ta lại For... Next thêm 1 lần nữa để trích ra cái ta cần ---> Dễ hơn ăn khoai

 

[Hoàng Trọng Nghĩa]

Cụ thể em làm cả 2 Hàm trong 1 File mà công việc em đang làm đây, 1 sheet thì cần Lọc duy nhất, nhưng không biết xử lý Hàm như thế nào; 1 sheet thì cần lọc không rỗng, xử lý được, nhưng lại double Hàm mới xong.

Giúp đỡ dùm em nhé! Cám ơn rất nhiều!

 

[ptm0412]

Cụ thể em làm cả 2 Hàm trong 1 File mà công việc em đang làm đây, 1 sheet thì cần Lọc duy nhất, nhưng không biết xử lý Hàm như thế nào

Làm theo ndu đi: Khoai luộc đây, 7 cột chỉ lấy 3 theo thứ tự 1, 6, 3:

Sub Test()
...
Arr2 = Unique2DArray(...)
ReDim Arr3(1 to UBound(Arr2, 1), [COLOR=#ff0000][B]3[/B][/COLOR])
For i =1 to UBound(Arr2, 1)
  Arr3(i, 1) = Arr2(i, [COLOR=#ff0000]1[/COLOR])
  Arr3(i, 2) = Arr2(i, [COLOR=#ff0000]6[/COLOR]) 
  Arr3(i, 3) = Arr2(i, [COLOR=#ff0000]3[/COLOR])
Next
Ẹc ẹc
End Sub

 

[ndu96081631]

Cụ thể em làm cả 2 Hàm trong 1 File mà công việc em đang làm đây, 1 sheet thì cần Lọc duy nhất, nhưng không biết xử lý Hàm như thế nào; 1 sheet thì cần lọc không rỗng, xử lý được, nhưng lại double Hàm mới xong.

Giúp đỡ dùm em nhé! Cám ơn rất nhiều!

Trời...
Ví bạn có nói rằng:

còn TRỌNG LƯỢNG sẽ cộng dồn theo MÃ CHỦ HÀNG sau khi đã thực hiện các cột kia.

Vậy sao lại không dùng PivotTable mà dùng code chi cho mệt?
Nói thêm: Cho đến thời điểm này, tôi nghiên cứu Array và nhận xét rằng: Xử lý mảng có thể cho tốc độ nhanh hơn AutoFilter, Advanced Filter còn với PivotTalbe thì chưa có cách nào "thắng" nó được

 

[Hoàng Trọng Nghĩa]

Trời...
Ví bạn có nói rằng:

Vậy sao lại không dùng PivotTable mà dùng code chi cho mệt?
Nói thêm: Cho đến thời điểm này, tôi nghiên cứu Array và nhận xét rằng: Xử lý mảng có thể cho tốc độ nhanh hơn AutoFilter, Advanced Filter còn với PivotTalbe thì chưa có cách nào "thắng" nó được

Cột Trọng lượng em tự làm, chỉ cần trích lọc ra 3 cột kia thôi mà.

Cho em xin nói rõ rằng là, em đang học cách thức của các Hàm mà các Thầy làm, và em cũng biết rằng Pivot là nhanh, nhưng không nhất thiết dùng Pivot trong các biểu mẫu.

Em đã làm như vầy rồi, thật tình không hiểu nguyên lý của mảng nên em không biết sai chỗ nào mà cột J lại là không có, lại bắt đầu từ cột K:

Sub Test2()
  Dim sArray, Arr, Arr2, i As Long
  
  sArray = Range(Sheet1.[A2], Sheet1.[A65536].End(xlUp)).Resize(, 7)
  Arr = Unique2DArray(sArray, 1, True)
  
  ReDim Arr2(1 To UBound(Arr, 1), 3)
  
  For i = 1 To UBound(Arr, 1)
    Arr2(i, 1) = Arr(i, 1)
    Arr2(i, 2) = Arr(i, 6)
    Arr2(i, 3) = Arr(i, 3)
  Next
  
  If IsArray(Arr2) Then Sheet1.Range("J1").Resize(UBound(Arr2, 1), 3).Value = Arr2
End Sub

 

[ndu96081631]

Cột Trọng lượng em tự làm, chỉ cần trích lọc ra 3 cột kia thôi mà.

Cho em xin nói rõ rằng là, em đang học cách thức của các Hàm mà các Thầy làm, và em cũng biết rằng Pivot là nhanh, nhưng không nhất thiết dùng Pivot trong các biểu mẫu.

Em đã làm như vầy rồi, thật tình không hiểu nguyên lý của mảng nên em không biết sai chỗ nào mà cột J lại là không có, lại bắt đầu từ cột K:

Sub Test2()
  Dim sArray, Arr, Arr2, i As Long
  
  sArray = Range(Sheet1.[A2], Sheet1.[A65536].End(xlUp)).Resize(, 7)
  Arr = Unique2DArray(sArray, 1, True)
  
  ReDim Arr2(1 To UBound(Arr, 1), 3)
  
  For i = 1 To UBound(Arr, 1)
    Arr2(i, 1) = Arr(i, 1)
    Arr2(i, 2) = Arr(i, 6)
    Arr2(i, 3) = Arr(i, 3)
  Next
  
  If IsArray(Arr2) Then Sheet1.Range("J1").Resize(UBound(Arr2, 1), 3).Value = Arr2
End Sub

Sai chổ này: ReDim Arr2(1 To UBound(Arr, 1), 3)
Lý ra phải là: ReDim Arr2(1 To UBound(Arr, 1), 1 To 3)

 

[Hoàng Trọng Nghĩa]

Sai chổ này: ReDim Arr2(1 To UBound(Arr, 1), 3)
Lý ra phải là: ReDim Arr2(1 To UBound(Arr, 1), 1 To 3)

À, lợi dụng tại điểm này, mình cho cách khoảng 1 cột được không ta?

 

[ptm0412]

Lỗi chỗ này, do làm chay nên sót:
ReDim Arr2(1 To UBound(Arr, 1), 1 To 3)

Ngoài ra, do yêu cầu trong file dữ liệu thật, thì làm thử trong file này:

À, lợi dụng tại điểm này, mình cho cách khoảng 1 cột được không ta?

 ReDim Arr2(1 To UBound(Arr, 1), 1 To [COLOR=#ff0000]4[/COLOR])
  For i = 1 To UBound(Arr, 1)
    Arr2(i, 1) = Arr(i, 1)
    Arr2(i, 2) = Arr(i, 6)
    Arr2(i, [COLOR=#ff0000]4[/COLOR]) = Arr(i, 3)
  Next

Tức là bỏ trống cột 3 của Arr2 để sum siếc trên sheet.
Quái, những cái này lại là quá căn bản chứ lị?

Và,
Đồng ý với ndu, hãy dùng Pivot table, nếu dùng VBA hãy dùng VBA với Pivot table.

 

[ndu96081631]

À, lợi dụng tại điểm này, mình cho cách khoảng 1 cột được không ta?

Không được đâu...
Bạn thí nghiệm thế này sẽ thấy:
- Giữ nguyên code của bạn
- Gõ gì đó vào J1:J10
- Chạy code
===> Sẽ thấy cột J bị xóa sạch

 

[Hoàng Trọng Nghĩa]

Trời ơi, nhờ 2 Sư phụ mà em học nhiều điều từ mãng quá, đúng là nhờ thực tế mà em đã học được thật nhiều, chứ đọc không vẫn không hiểu nổi, phải làm thử, làm thử rồi mới hơi hiểu hiểu được và nhờ các Thầy mới thông suốt được.

Hai Sư phụ mà gần đây thì mời hai Sư phụ vào Two Dream cho cái vụ mãng này rồi, thêm Hải mã Nhân sâm nữa, ui da....

 

[ndu96081631]

Hai Sư phụ mà gần đây thì mời hai Sư phụ vào Two Dream cho cái vụ mãng này rồi, thêm Hải mã Nhân sâm nữa, ui da....

Thì về Biên Hòa, tôi đâu có... ngại ăn uống (miễn là có báo trước)
Ẹc... Ẹc...

 

[ptm0412]

Không được đâu...
Bạn thí nghiệm thế này sẽ thấy:
- Giữ nguyên code của bạn
- Gõ gì đó vào J1:J10
- Chạy code
===> Sẽ thấy cột J bị xóa sạch

Trong file dữ liệu thật của tác giả cũng thấy xoá hết trước khi gán kết quả xuống. Vậy thì bỏ trống 1 cột trong Array không sao cả.

Ngoài ra, nếu cần giữ lại 1 cột ở giữa, thì cũng vẫn có cách: Thay vì 1 Array KQ, dùng 2 Array:
1 Array 2 cột, lấy giá trị cột 1 và 6, gán xuống đây,
1 Array 1 cột, lấy giá trị cột 3, gán xuống kia
Cả 2 Array này cũng chỉ dùng 1 vòng For ... next gán vào.

 

[concogia]

Trời ơi, nhờ 2 Sư phụ mà em học nhiều điều từ mãng quá, đúng là nhờ thực tế mà em đã học được thật nhiều, chứ đọc không vẫn không hiểu nổi, phải làm thử, làm thử rồi mới hơi hiểu hiểu được và nhờ các Thầy mới thông suốt được.

Hai Sư phụ mà gần đây thì mời hai Sư phụ vào Two Dream cho cái vụ mãng này rồi, thêm Hải mã Nhân sâm nữa, ui da....

Thằng "Dít To" và Mảng hơi bị mơ hồ, tìm hiểu thì phải tìm từ cái dễ & đơn giản nhất, lao vào cái hàm ....của Thầy ndu thì.....u đầu là phải rồi, còn la làng chi nữa
Trong file của em gởi lên, nếu vì lý do nào đó không sử dụng Pivot thì chơi nó bằng Sub lọc bình thường thôi chứ sao lại lấy cái hàm "hóc búa" vào sử dụng (cái hàm đó để tìm hiểu, học tập thì Ok ), dùng sự kiện Active của Worksheet hoặc cái chi chi cũng được

Private Sub Worksheet_Activate()
Dim d, Vung, Mg(), Ws, I, K, Socot, CotLay
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets("CSDL")
    Vung = Ws.Range(Ws.[a2], Ws.[a50000].End(xlUp)).Resize(, 9).Value
    ReDim Mg(1 To UBound(Vung), 1 To 4)
        For I = 1 To UBound(Vung)
            If Not d.exists(Vung(I, 1)) Then
                K = K + 1
                d.Add Vung(I, 1), Nothing
                Mg(K, 1) = Vung(I, 1): Mg(K, 2) = Vung(I, 9): Mg(K, 4) = Vung(I, 7)
            End If
        Next I
    [a2:d10000].ClearContents
    [a2].Resize(d.Count, 4) = Mg
End Sub

Mà cột tổng trọng lượng mắc mớ gì làm sau, em "Đít to" & mảng phối hợp với nhau cộng dồn cùng lúc với các cột kia luôn
Còn muốn tổng quát hơn tí, muốn lấy các cột không liền kề mà nhảy cóc tùm lum ta có thể làm như thế này:

Public Sub DiTTo()
    Dim d, Vung, Mg(), Ws, I, J, K, Socot, CotLay, Tam, SoMang, Cot
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets("CSDL")
    Vung = Ws.Range(Ws.[a2], Ws.[a50000].End(xlUp)).Resize(, 9).Value
    Socot = Application.InputBox("Nhap so cot cua mang", , , , , , , 1)
    CotLay = Application.InputBox("Nhap stt Mang & sô cot muon lay")
    ReDim Mg(1 To UBound(Vung), 1 To Socot)
        For I = 1 To UBound(Vung)
            If Not d.exists(Vung(I, 1)) Then
                K = K + 1
                d.Add Vung(I, 1), Nothing
                Tam = Split(CotLay, ",")
                    For J = 1 To Socot
                        SoMang = Val(Left(Tam(J - 1), InStr(Tam(J - 1), "-") - 1))
                        Cot = Val(Right(Tam(J - 1), Len(Tam(J - 1)) - InStr(Tam(J - 1), "-")))
                        Mg(K, SoMang) = Vung(I, Cot)
                    Next J
            End If
        Next I
    [a2:d10000].ClearContents
    [a2].Resize(d.Count, SoCot) = Mg
End Sub

Khi chạy code, xuất hiện bảng nhập số cột của mảng kết quả, thí dụ là 4
Ok, xuất hiện tiếp bảng muốn lấy kết quả ở cột nào, cú pháp (thí dụ) nhập:
1-1,2-6,3-9,4-5
Có nghĩa là: cột 1 của mảng kết quả sẽ lấy dữ liệu cột 1 của vùng dữ liệu lọc mà mình đã khai báo
Tương tự: cột 2 của mảng lấy cột 6 của vùng lọc; cột 3 của mảng lấy cột 9 của vùng lọc....
(Dĩ nhiên ta cũng có thể khai báo cột muốn lọc trong vùng lọc nếu thấy cần)
Thân
Còn nếu chưa hiểu em "Đít to" thì mời tớ 5 ve tớ "Chỏ chi"
Làm đại (do chợt nghĩ ra) nên chưa test hết các vấn đề có thể nảy sinh, Minhthien thử nhé

 

[Hoàng Trọng Nghĩa]

Sau khi tập tành làm việc với Hàm mảng, lại làm phiền tiếp các Sư phụ rồi!

Nếu như tính tổng ở mảng ở cột thứ 3, xử lý luôn trên mảng thì phải làm thế nào?

Private Sub LocVaSumIf()
  Sheet2.Range("A2:D8").ClearContents
  If CSDL.[A2] = "" Then Exit Sub
  Dim i As Long, sArray, Arr1, Arr2
  sArray = Range(CSDL.[A2], CSDL.[A65536].End(xlUp)).Resize(, 12)
  Arr1 = Unique2DArray(sArray, 11, False)
  
  ReDim Arr2(1 To UBound(Arr1, 1), 1 To 4)

  For i = 1 To UBound(Arr1, 1)
    Arr2(i, 1) = Arr1(i, 11)
    Arr2(i, 2) = Arr1(i, 1)
    [COLOR=#ff0000][B]'Arr2(i, 3) = Arr1(i, 6) [/B][/COLOR][COLOR=#006400][B]'<< Tính SUMIF theo Mã tại cột 1, trọng lượng tại cột 6 cho từng phần tử thì tính như thế nào? [/B][/COLOR]
    Arr2(i, 4) = Arr1(i, 2)
  Next

  If IsArray(Arr2) Then Sheet2.Range("A2").Resize(UBound(Arr2, 1), 4).Value = Arr2
End Sub

Xin cảm ơn rất nhiều!

 

[ndu96081631]

Sau khi tập tành làm việc với Hàm mảng, lại làm phiền tiếp các Sư phụ rồi!

Nếu như tính tổng ở mảng ở cột thứ 3, xử lý luôn trên mảng thì phải làm thế nào?

Private Sub LocVaSumIf()
  Sheet2.Range("A2:D8").ClearContents
  If CSDL.[A2] = "" Then Exit Sub
  Dim i As Long, sArray, Arr1, Arr2
  sArray = Range(CSDL.[A2], CSDL.[A65536].End(xlUp)).Resize(, 12)
  Arr1 = Unique2DArray(sArray, 11, False)
  
  ReDim Arr2(1 To UBound(Arr1, 1), 1 To 4)

  For i = 1 To UBound(Arr1, 1)
    Arr2(i, 1) = Arr1(i, 11)
    Arr2(i, 2) = Arr1(i, 1)
    [COLOR=#ff0000][B]'Arr2(i, 3) = Arr1(i, 6) [/B][/COLOR][COLOR=#006400][B]'<< Tính SUMIF theo Mã tại cột 1, trọng lượng tại cột 6 cho từng phần tử thì tính như thế nào? [/B][/COLOR]
    Arr2(i, 4) = Arr1(i, 2)
  Next

  If IsArray(Arr2) Then Sheet2.Range("A2").Resize(UBound(Arr2, 1), 4).Value = Arr2
End Sub

Xin cảm ơn rất nhiều!

Muốn SUMIF thì phải SUM ngay từ đầu ---> Lọc Unique xong thì SUM nỗi gì chứ
Đây là 1 yêu cầu riêng nên e rằng phải viết riêng 1 sub chỉ xài riêng cho công việc này thôi, tức bỏ hàm Unique và viết lại từ đầu

 

[Hoàng Trọng Nghĩa]

Muốn SUMIF thì phải SUM ngay từ đầu ---> Lọc Unique xong thì SUM nỗi gì chứ
Đây là 1 yêu cầu riêng nên e rằng phải viết riêng 1 sub chỉ xài riêng cho công việc này thôi, tức bỏ hàm Unique và viết lại từ đầu

Vậy làm ơn viết sub đó cho em đi ạ. Em không thể biết cách làm. Nhìn Hàm Thầy viết em còn không hiểu được, huống hồ chi là làm riêng 1 sub mới.

Cám ơn Thầy!

 

[ptm0412]

Vậy làm ơn viết sub đó cho em đi ạ. Em không thể biết cách làm. Nhìn Hàm Thầy viết em còn không hiểu được, huống hồ chi là làm riêng 1 sub mới.

Cám ơn Thầy!

Sao không dùng code của cò già, có gợi ý tính tổng rồi đó?
Hay là sợ vụ "chỏ chi" với "chỉ cho"? Cỡ Cò già cũng đã làm sư phụ vô khối người rồi đó chứ bộ!

 

[Hoàng Trọng Nghĩa]

Sao không dùng code của cò già, có tính tổng rồi đó?
Hay là sợ vụ "chỏ chi" với "chỉ cho"? Cỡ Cò già cũng đã làm sư phụ vô khối người rồi đó chứ bộ!

Thật ra em không rành thuật toán này lắm, ngay từ đầu em đã nói vậy. Kế nữa Code của Concogia em test thấy có nhiều lỗi phát sinh, hàng cột của em thì lộn xộn cho nên em không thể làm theo cái InputBox đó được, chép về rồi test rồi để đó chứ chưa giải quyết được. Nói chung là cụ thể một chút thì em nghiên cứu, nghiền ngẫm sẽ hiểu dần dần, mới nhớ cách làm được.

Sau khi em lọc duy nhất xong thì làm thêm thủ tục này, tuy nhiên đối với em thì sao cũng được, nhưng người hiểu biết sẽ cười, đã xử lý trên mảng mà còn thế này:

Sub SumIFW()
  Dim Rng As Range
  Set Rng = Range(CSDL.[K2], CSDL.[K65536].End(xlUp))
  For i = 2 To Sheet2.[A65536].End(xlUp).Row
    Sheet2.Range("C" & i) = WorksheetFunction.SumIf(Rng, Sheet2.Range("A" & i), Rng.Offset(, -5))
  Next
End Sub

Hì hì, cái vụ "Chỏ chi" thì dễ ẹc chứ có gì đâu Sư phụ! Em và Concogia gặp nhau hà rầm, mới nhậu cách vài ngày đó thôi!

 

[concogia]

Thật ra em không rành thuật toán này lắm, ngay từ đầu em đã nói vậy. Kế nữa Code của Concogia em test thấy có nhiều lỗi phát sinh, hàng cột của em thì lộn xộn cho nên em không thể làm theo cái InputBox đó được, chép về rồi test rồi để đó chứ chưa giải quyết được. Nói chung là cụ thể một chút thì em nghiên cứu, nghiền ngẫm sẽ hiểu dần dần, mới nhớ cách làm được.

Sau khi em lọc duy nhất xong thì làm thêm thủ tục này, tuy nhiên đối với em thì sao cũng được, nhưng người hiểu biết sẽ cười, đã xử lý trên mảng mà còn thế này:

Sub SumIFW()
  Dim Rng As Range
  Set Rng = Range(CSDL.[K2], CSDL.[K65536].End(xlUp))
  For i = 2 To Sheet2.[A65536].End(xlUp).Row
    Sheet2.Range("C" & i) = WorksheetFunction.SumIf(Rng, Sheet2.Range("A" & i), Rng.Offset(, -5))
  Next
End Sub

Hì hì, cái vụ "Chỏ chi" thì dễ ẹc chứ có gì đâu Sư phụ! Em và Concogia gặp nhau hà rầm, mới nhậu cách vài ngày đó thôi!

Lọc duy nhất & cộng dồn dùng "Đit to" & mảng cũng không đến nỗi khó lắm, bài của Minhthien chỉ cần thế này thôi

Public Sub KhoHieuQua()
Dim d, Vung, Mg(), Ws, I, K, kK
    Set d = CreateObject("scripting.dictionary")
    Set Ws = Sheets("CSDL")
    Vung = Ws.Range(Ws.[a2], Ws.[a50000].End(xlUp)).Resize(, 12).Value
    ReDim Mg(1 To UBound(Vung), 1 To 4)
        For I = 1 To UBound(Vung)
            If Not d.exists(Vung(I, 1)) Then
                K = K + 1
                [I][B]d.Add Vung(I, 1), K
[/B][/I]              Mg(K, 1) = Vung(I, 1): Mg(K, 2) = Vung(I, 9): Mg(K, 3) = Vung(I, 12): Mg(K, 4) = Vung(I, 7)
            Else
                kK = d.Item(Vung(I, 1))
                Mg(kK, 3) = Mg(kK, 3) + Vung(I, 12)
            End If
        Next I
    [a2:d10000].ClearContents
    [a2].Resize(d.Count, 4) = Mg
End Sub

Cách làm (gọi "thuật toán" nghe nó sao sao í ):
Dùng Dictionary kiểm tra xem dũ liệu tuần tự ở cột A sheet "CSDL" có trong Dic chưa :
- Trường hợp chưa có thì gán dữ liệu đó vào Dic, gán Item của Dic là K (chỗ in đậm & nghiêng) đồng thời gán dữ liệu vào mảng. Cột thứ 3 của mảng sẽ gán cột "Trọng lượng" ( cột 12)
- Trường hợp có rồi thì dùng câu lệnh kK = d.Item(Vung(I, 1)) kiếm xem cái thằng đang dò mà có rồi nó nằm ở hàng thứ mấy trong mảng, lôi cổ thằng đó ra lấy cột thứ 3 ( cột trọng lượng) cộng với thằng mình đang dò "Vung(I,12)"
Híc, hổng biết rõ chưa nữa ???

 

[ndu96081631]

Thật ra em không rành thuật toán này lắm, ngay từ đầu em đã nói vậy. Kế nữa Code của Concogia em test thấy có nhiều lỗi phát sinh, hàng cột của em thì lộn xộn cho nên em không thể làm theo cái InputBox đó được, chép về rồi test rồi để đó chứ chưa giải quyết được. Nói chung là cụ thể một chút thì em nghiên cứu, nghiền ngẫm sẽ hiểu dần dần, mới nhớ cách làm được.

Sau khi em lọc duy nhất xong thì làm thêm thủ tục này, tuy nhiên đối với em thì sao cũng được, nhưng người hiểu biết sẽ cười, đã xử lý trên mảng mà còn thế này:

Sub SumIFW()
  Dim Rng As Range
  Set Rng = Range(CSDL.[K2], CSDL.[K65536].End(xlUp))
  For i = 2 To Sheet2.[A65536].End(xlUp).Row
    Sheet2.Range("C" & i) = WorksheetFunction.SumIf(Rng, Sheet2.Range("A" & i), Rng.Offset(, -5))
  Next
End Sub

Hì hì, cái vụ "Chỏ chi" thì dễ ẹc chứ có gì đâu Sư phụ! Em và Concogia gặp nhau hà rầm, mới nhậu cách vài ngày đó thôi!

Thật ra viết 1 hàm (hoặc 1 sub) để trích lọc duy nhất và tính tổng thật sự không có vấn đề
Ví dụ trích lọc dữ liệu có 5 cột, trong đó 4 cột đầu trích lọc duy nhất, cột thứ 5 cộng dồn
Điều băn khoăn của tôi ở đây là khi trích lọc ra, bạn lại đảo lộn trật tự các cột so với dữ liệu gốc... đã vậy còn lấy kết quả cách cột (không liên tục) nên không biết làm sao để viết hàm cho tổng quát
Còn nếu chỉ phục vụ cho đúng file này thì viết vầy:

Sub Test()
  Dim sArray, i As Long, iR As Long, Tmp, Arr()
  On Error Resume Next
  Sheet2.Range("A2:D10000").ClearContents
  sArray = CSDL.Range(CSDL.[A2], CSDL.[A65536].End(xlUp)).Resize(, 12).Value
  ReDim Arr(1 To UBound(sArray, 1), 1 To 4)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(sArray, 1)
      If sArray(i, 11) <> "" Then
        Tmp = sArray(i, 11) '<--- Day la cai can loc duy nhat
        If Not .Exists(Tmp) Then
          iR = iR + 1
          .Add Tmp, iR
          Arr(iR, 1) = Tmp
          Arr(iR, 2) = sArray(i, 1)
          Arr(iR, 3) = sArray(i, 6) '<--- Cot nay can cong don
          Arr(iR, 4) = sArray(i, 2)
        Else
          Arr(.Item(Tmp), 3) = Arr(.Item(Tmp), 3) + sArray(i, 6)
        End If
      End If
    Next
  End With
  If iR Then Sheet2.Range("A2").Resize(iR, 4).Value = Arr
End Sub

 

[ptm0412]

Ẹc, nếu không chọc tức thì Cò đâu có ra tay. Bài trước của Cò chỉ nhá cho người ta thèm thôi

Cò viết lại lấy tham số truyền chẳng hạn như các tham số: cột cần lọc, cột cần lấy, cột cần tính tổng. Dẫu chỉ là sub nhưng cũng có thể tổng quát.

 

[ndu96081631]

Cò viết lại lấy tham số truyền chẳng hạn như các tham số: cột cần lọc, cột cần lấy, cột cần tính tổng. Dẫu chỉ là sub nhưng cũng có thể tổng quát.

Nếu phải viết ở mức tổng quát thì chổ này em chẳng biết viết sao nữa... Ví dụ:
- Lấy 6 cột theo trật tự: 5, 7, 2, 1, 8, 12
- Cột cần lọc duy nhất là cột 5
- Cột cần SUMIF là cột 2 và 12 (đương nhiên SUMIF theo cột 5)
Vậy viết 1 Function hoặc sub với tham số truyền sẽ viết.. sao đây?
------------------
Bài toán này nếu là PivotTale nó làm cái rẹt ra ngay (chỉ là chổ cần SUM buộc phải nằm về bên phải)

 

[Hoàng Trọng Nghĩa]

Hay thật, nhìn thuật toán của Bác Cò và của Thầy NDU gần như là giống nhau hoàn toàn, chỉ khác tên biến.

Bảo đảm chừng vài năm nữa em sẽ làm tốt đối với mảng. Từ trước đến nay chỉ mê những thủ thuật (màu mè đó) mà không chú ý tới xử lý mảng, dữ liệu nên chưa quan tâm đến. Giờ sẽ chuyên cần nghiên cứu vấn đề này.

Cám ơn các Thầy đã quan tâm nhé!

 

[concogia]

Mình nghĩ yêu cầu của Minhthien chắc cũng làm được, truyền tham số vào các cột lấy dữ liệu chỉ cần 1 số, còn cột mảng kết quả mặc định bắt đầu chạy từ 1. Cột dùng để lọc cũng dễ rồi, chỉ có cột cộng dồn, chắc phải có dấu hiệu riêng khi truyền tham số lấy các cột kết quả để lôi mấy em đó ra mà cộng.
Thí du : 3,4,+5,12,6,+7 ==> cột 1 của mảng kết quả lấy cột 3, ...,cột 3 của mảng kết quả lấy cột 5 ( cộng dồn).....Mới nghĩ trong đầu thế thôi
Mà cái yêu cầu này cũng ngộ
Híc

 

[ptm0412]

tham số truyền thí dụ vầy:

Sub UniqueAndSum(sArray, ArrCols , UniqueCol, SumCol)
...
End Sub

Sub Test()
UniqueAndSum Range("A1:K2000"), Array(1, 3, 7, 4), 3, 7
Ẹc ẹc
End Sub

Tức là lọc duy nhất theo cột 3 của range A1:K2000, lấy 4 cột 1, 3, 7 ,4 theo thứ tự, trong đó cột 7 tính SumIf theo cột 3
Nếu Sum nhiều cột thì ArrSumCol (nhưng chua, không làm được với 1 Dic)

 

[ndu96081631]

tham số truyền thí dụ vầy:

Sub UniqueAndSum(sArray, ArrCols , UniqueCol, SumCol)
...
End Sub

Sub Test()
UniqueAndSum Range("A1:K2000"), Array(1, 3, 7, 4), 3, 7
Ẹc ẹc
End Sub

Tức là lọc duy nhất theo cột 3 của range A1:K2000, lấy 4 cột 1, 3, 7 ,4 theo thứ tự, trong đó cột 7 tính SumIf theo cột 3
Nếu Sum nhiều cột thì ArrSumCol (nhưng chua, không làm được với 1 Dic)

Cũng chỉ cần 1 Dic thôi sư phụ à! Code của em ở trên đánh dấu vị trí iR, từ đó truy xuất thôi

 

[ptm0412]

Cũng chỉ cần 1 Dic thôi sư phụ à! Code của em ở trên đánh dấu vị trí iR, từ đó truy xuất thôi

Ẹc, 1 Dic chỉ có 1 key và 1 Item. Key thì đã dùng cho duy nhất, Item thì dùng để cộng dồn. Cộng dồn 1 field thôi chứ? Làm sao cộng dồn cho 2 field riêng rẽ?
Nghĩa là 2 cột cần 2 sumif chứ không phải sumif 2 cột vào 1.
Với lại, nếu dùng ArrSumCol, chưa biết trong đó có bao nhiêu phần tử à nha.

 

[ndu96081631]

Ẹc, 1 Dic chỉ có 1 key và 1 Item. Key thì đã dùng cho duy nhất, Item thì dùng để cộng dồn. Cộng dồn 1 field thôi chứ? Làm sao cộng dồn cho 2 field riêng rẽ?
Nghĩa là 2 cột cần 2 sumif chứ không phải sumif 2 cột vào 1.

Hổng phải vậy! Item của em không dùng để cộng dồn mà để ĐÁNH DẤU VỊ TRÍ sư phụ à (vị trí là iR)
Từ đây ArrKQ sẽ cộng dồn theo vị trí iR tìm đươc

 

[concogia]

Ẹc, 1 Dic chỉ có 1 key và 1 Item. Key thì đã dùng cho duy nhất, Item thì dùng để cộng dồn. Cộng dồn 1 field thôi chứ? Làm sao cộng dồn cho 2 field riêng rẽ?
Nghĩa là 2 cột cần 2 sumif chứ không phải sumif 2 cột vào 1.
Với lại, nếu dùng ArrSumCol, chưa biết trong đó có bao nhiêu phần tử à nha.

Được chứ Thầy, 1 Dic trong đó Keys là duy nhất & Items ....cũng duy nhất luôn - vì Item là số thứ tự của mảng kết quả-, 2 cột SumIf hay nhiều hơn cũng được mà Thầy - vì bao nhiêu SumIf cũng phải theo Key ==> lấy Item của Key đó ==> thứ tự của Mảng kết quả
Híc, Minhthien đâu zồi ???

 

[Hoàng Trọng Nghĩa]

Được chứ Thầy, 1 Dic trong đó Keys là duy nhất & Items ....cũng duy nhất luôn - vì Item là số thứ tự của mảng kết quả-, 2 cột SumIf hay nhiều hơn cũng được mà Thầy - vì bao nhiêu SumIf cũng phải theo Key ==> lấy Item của Key đó ==> thứ tự của Mảng kết quả
Híc, Minhthien đâu zồi ???

Dạ, em đang dựa cột mà nghe. Không dám thưa thốt gì hết!

 

[ptm0412]

À, đúng rồi, đánh dấu Array Kết Quả, và cộng vào Arr kết quả. Lúc nãy đọc code nhầm thành cộng dồn vào Item.
Zậy Cò làm hén?

 

[ptm0412]

Ẹc ẹc, đã làm xong. Test 50.000 dòng mất có 0,6 giây
Nói không bằng làm, làm không bằng cho xem:

Option Base 1
Sub UniqueAndSum(sArray, ArrCols, UniqueCol, ArrSumCols)
  Dim i, j, k, h As Long, iR As Long, Tmp, ReArr()
  On Error Resume Next
  ReDim Arr(1 To UBound(sArray, 1), 1 To UBound(ArrCols))
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(sArray, 1)
      If sArray(i, UniqueCol) <> "" Then
        Tmp = sArray(i, UniqueCol)
        If Not .Exists(Tmp) Then
          iR = iR + 1
          .Add Tmp, iR
          For j = 1 To UBound(ArrCols)
            Arr(iR, j) = sArray(i, ArrCols(j))
          Next j
        Else
            For j = 1 To UBound(ArrCols)
                For k = 1 To UBound(ArrSumCols)
                If ArrCols(j) = ArrSumCols(k) Then
                    Arr(.Item(Tmp), j) = Arr(.Item(Tmp), j) + sArray(i, ArrSumCols(k))
                End If
                Next k
            Next j
        End If
      End If
    Next i
  End With
  For h = 1 To UBound(ArrCols)
    Sheet2.Cells(1, h + 6) = Sheet1.Cells(1, ArrCols(h))
  Next h
  Sheet2.Range("G2").Resize(iR, UBound(ArrCols)).Value = Arr
End Sub

Sub Test()
  Sheet2.Range("G1:K100").ClearContents
  Arr1 = Sheet1.Range("A2:G50001").Value
  t = Timer
  UniqueAndSum Arr1, Array(2, 1, 7, 6), 2, Array(6, 7)
  Sheet2.[f1] = Timer - t
End Sub

Cho xem không bằng cho thử: Tải file đính kèm về chạy thử.
Cái này sửa 1 chút xíu là thành Function luôn

 

[thanhlanh]

Ẹc ẹc, đã làm xong. Test 50.000 dòng mất có 0,6 giây
Nói không bằng làm, làm không bằng cho xem:


Cho xem không bằng cho thử: Tải file đính kèm về chạy thử.
Cái này sửa 1 chút xíu là thành Function luôn

Thử không bằng trả lời:
Làm cả hai cách luôn. Anh đúng là cao thủ võ lâm.
Máy cùi bắp của em cũng chỉ chạy mất 0,45s để xử lý 50k dòng dữ liệu
Biết vậy thôi chớ chưa thể tiêu hoá code ngay nên không thể "cãi lại" được, he he.

 

[Hoàng Trọng Nghĩa]

Ẹc ẹc, đã làm xong. Test 50.000 dòng mất có 0,6 giây
Nói không bằng làm, làm không bằng cho xem:
Cho xem không bằng cho thử: Tải file đính kèm về chạy thử.
Cái này sửa 1 chút xíu là thành Function luôn

Phải nói gì ta??? Quá tuyệt vời!

À nếu Sư phụ khai báo rõ ràng hơn sẽ cải thiện tốc độ đáng kể luôn!

Dim i As Long, j As Long, k As Long, h As Long, iR As Long

Tốc độ đo được là: 0.389999389648437

Cám ơn Sư phụ!

 

[thanhlanh]

Phải nói gì ta??? Quá tuyệt vời!

À nếu Sư phụ khai báo rõ ràng hơn sẽ cải thiện tốc độ đáng kể luôn!

Dim i As Long, j As Long, k As Long, h As Long, iR As Long

Tốc độ đo được là: 0.389999389648437

Cám ơn Sư phụ!

Ừ nhỉ, không những nhanh hơn mà hình như ổn định hơn, chạy thử 10 lần là biết, tốc độ của các lần chạy ít thay đổi.

 

[ndu96081631]

Ẹc ẹc, đã làm xong. Test 50.000 dòng mất có 0,6 giây
Nói không bằng làm, làm không bằng cho xem:
Cho xem không bằng cho thử: Tải file đính kèm về chạy thử.
Cái này sửa 1 chút xíu là thành Function luôn

Đến giai đoạn này thì thấy rõ ràng việc có thêm biến HasTitle nó lợi hại thế nào...
- Nếu HasTitle = True... thích hợp khi làm việc với Range
- Nếu HasTitle = False... thích hợp khi làm việc với ComboBox, ListBox
Tức không phải lúc nào người ta cũng muốn lấy tiêu đề và ngược lại
Ngoài ra, đã xác định dữ liệu nguồn là 1 Array (sArray) thì không thể biết trước nó thuộc Base 0 hay Base 1 (dữ liệu có thể nhận từ bất cứ nguồn nào mà)
Ẹc... Ẹc... cải tiến thêm bước này phải tốn thêm chút mồ hôi nữa mới xong!

 

[ptm0412]

Vụ HasTitle tạm khoan đã, bi giờ bổ sung chức năng chèn cột trống, mấy cột cũng được, liền nhau cũng được, cách quãng cũng được. (đừng bỏ đầu hoặc cuối, cũng được mà zô ziên lắm)

Muốn trống cột nào, thêm số 0 ở vị trí đó trong ArrCols

Thí dụ:

UniqueAndSum Arr1, Array(2, 1, 0, 7, 6), 2, Array(6, 7)
UniqueAndSum Arr1, Array(2, 1, 0, 0, 7, 6), 2, Array(6, 7)
UniqueAndSum Arr1, Array(2, 1, 0, 4, 0, 7, 6), 2, Array(6, 7)

Code chính sửa 2 dòng: (không sửa cũng được tốt, vì đã On Error Resume Next)

          For j = 1 To UBound(ArrCols)
                [COLOR=#ff0000]If ArrCols(j) > 0 Then [/COLOR]Arr(iR, j) = sArray(i, ArrCols(j))
          Next j
.......
  For h = 1 To UBound(ArrCols)
   [COLOR=#ff0000]If ArrCols(h) > 0 Then[/COLOR] Sheet2.Cells(1, h + 6) = Sheet1.Cells(1, ArrCols(h))
  Next h

 

[thanhlanh]

Đến giai đoạn này thì thấy rõ ràng việc có thêm biến HasTitle nó lợi hại thế nào...
- Nếu HasTitle = True... thích hợp khi làm việc với Range
- Nếu HasTitle = False... thích hợp khi làm việc với ComboBox, ListBox
Tức không phải lúc nào người ta cũng muốn lấy tiêu đề và ngược lại
Ngoài ra, đã xác định dữ liệu nguồn là 1 Array (sArray) thì không thể biết trước nó thuộc Base 0 hay Base 1 (dữ liệu có thể nhận từ bất cứ nguồn nào mà)
Ẹc... Ẹc... cải tiến thêm bước này phải tốn thêm chút mồ hôi nữa mới xong!

Trong code của ndu có câu:
For i = LBound(TmpArr, 1) - HasTitle To UBound(TmpArr, 1)
Thằng LBound(TmpArr, 1) khác kiểu với thằng này HasTitle mà sao cộng trừ được hỉ?

 

[ptm0412]

Khi cộng trừ boolean trong VBA:
True = -1
False = 0
Chắc thanhlanh muốn đổ 1 chút mồ hôi chăng?

 

[thanhlanh]

Khi cộng trừ boolean trong VBA:
True = -1
False = 0
Chắc thanhlanh muốn đổ 1 chút mồ hôi chăng?

Biết rồi, nhưng chuyển đổi trước mới cộng trừ nhân chia cho dể nhìn được không?: CDbl(HasTitle) chẳng hạn.

 

[ndu96081631]

Biết rồi, nhưng chuyển đổi trước mới cộng trừ nhân chia cho dể nhìn được không?: CDbl(HasTitle) chẳng hạn.

Nếu chuyển như vậy là quá tốt rồi, còn không cũng không có vấn đề gì
Để ý trong bảng tính, nếu A1=1, B1 =TRUE thì C1=A1+B1 vẫn = 2 như thường

 

[Hoàng Trọng Nghĩa]

Cứ cái đà này các Sư phụ sẽ thay thế thằng Pivot Table mất thôi! Để cho nó có đất sống nữa chứ!

Hôm qua em cải tiến chút xíu về việc cộng dồn có điều kiện, ví dụ nhỏ hơn 1 số nào đó, hoặc lớn hơn số nào đó, kết quả các hàng phía dưới ra như ý, nhưng hàng phía trên cùng hình như nó vẫn cộng thêm 1 giá trị đầu tiên nên bị sai. E rằng tại mình mò đại mà không đúng nên không quan tâm cũng chẳng lưu lại.

 

[ndu96081631]

Cứ cái đà này các Sư phụ sẽ thay thế thằng Pivot Table mất thôi! Để cho nó có đất sống nữa chứ!

Hôm qua em cải tiến chút xíu về việc cộng dồn có điều kiện, ví dụ nhỏ hơn 1 số nào đó, hoặc lớn hơn số nào đó, kết quả các hàng phía dưới ra như ý, nhưng hàng phía trên cùng hình như nó vẫn cộng thêm 1 giá trị đầu tiên nên bị sai. E rằng tại mình mò đại mà không đúng nên không quan tâm cũng chẳng lưu lại.

Đảm bảo với bạn rằng PivotTable là thứ mà ta không thể tranh chấp về tốc độ được
Để ý rằng chỉ khi Refresh Data thì nó mới tính toán lại, còn không thì nó vẫn hiển thị lại dữ liệu mà nó đã lưu (ở đâu đó, không biết được)
Còn hàm của ta viết, cứ chạy là phải tính toán từ đâu ---> Thua tốc độ ở chổ này là cái chắc

 

[ptm0412]

MinhThien mang sách Pivot Table về chắc không đọc kỹ rồi. Không kể đến tốc dộ tính toán, có những chức năng của Pivot Table mà không gì có thể so sánh được:

1. Pivot table có khả năng tổng hợp và phân tích đa cấp:
- Ngay trong file UniqueAndSum, Nếu kéo thêm Field04 vào Pivot table, Pivot sẽ tổng hợp chung cho từng Name, và riêng cho từng mục từ VBA001 đến VBA100.
- Nếu kéo thêm trường Maso02 vào, sẽ tổng hợp 3 cấp.
- Pivot table có thể đổi cấp tổng hợp: Chỉ cần đổi chỗ 1 field từ phải qua trái, cấp tổng hợp cho field đó sẽ đổi từ cấp thấp hơn dổi thành cấp cao hơn.

2. Sự đa dạng trong tính toán:
- Nếu sử dụng field setting ta sẽ có không chỉ Sum, Min, Max, mà còn có hàng chục cách tính toán khác nhau
- Nếu 1 field kéo thả vào Data Area nhiều lần, ta có thể vừa tính Sum, vừa tính Min, vừa tính Max, Average, ...

3. Pivot table tổng hợp và phân tích theo cả 2 chiều ngang và dọc:
- Nếu kéo thả 1 trường nào đó vào Column Area, ta sẽ có cả tổng hợp và phân tích.
- CHiều ngang cũng có thể đa cấp y như chiều dọc

4. ....

Đối với mỗi cái click chuột, mỗi cái kéo thả thêm bớt, đổi chỗ, hoán vị, ... của Pivot table, ta phải viết 1 code dài ngoằng. Thậm chí có những cái viết code không nổi, thậm chí vô phương.
Vậy:
còn khuya mới viết code thay thế được Pivot,
còn khuya mới có cái gì thay thế được cho Pivot,
và
sách lão chết tiệt vẫn còn phải đọc dài dài!

 

[Hoàng Trọng Nghĩa]

Nói vui vậy chứ làm gì mà một vài cao thủ của ta có thể làm hơn hàng vạn cái đầu lập trình của Microsoft được! Em khen ngợi các Thầy nhưng hơi cường điệu chút thôi mà! Nhưng thuận tiện thì đường thẳng ta cứ đi!

 

[Dauthivan]

Em mới biết và thực hành về Sub thôi, Funtion em chỉ mới đọc lý thuyết, em chưa hiểu lắm một số điểm về Funtion mong sư phụ chỉ cho

Function UniqueList2D(UniqueCol As Long, sArray)
  Dim ReArr
  Dim iRw, iRws, iCols, iCol, iCount
  iRws = UBound(sArray, 1)
  iCols = UBound(sArray, 2)
  ReDim ReArr(1 To iRws, 1 To iCols)
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
        For iRw = 1 To iRws
          If sArray(iRw, UniqueCol) <> "" Then
            If Not .Exists(sArray(iRw, UniqueCol)) Then
                .Add sArray(iRw, UniqueCol), ""
                iCount = iCount + 1
                For iCol = 1 To iCols
                   ReArr(iCount, iCol) = sArray(iRw, iCol)
                Next
            End If
          End If
    Next
    UniqueList2D = ReArr
  End With
End Function

Sub TEST()
  Dim Arr1, Arr2
  With Range([A3], [A65536].End(xlUp)).Resize(, 7)
    Arr1 = .Cells
    Arr2 = UniqueList2D(4, Arr1)
    [J2].Resize(UBound(Arr2, 1), 7).Value = Arr2
  End With
End Sub

Em thắc mắc sArray tại sao nó không được định nghĩa trước thì biết nó là vùng nào? Phải chăng nó chính là Arr1?

Em muốn ứng với Giá trị cột D bằng 1 (tức cột 4) em muốn lấy Ho Cam Dao dong 9 chứ không phải Ho Cam Dao dong 8 thì làm sao hả thày?
----------
Hình như em cũng hơi hơi hiểu rồi (nếu có gì không phải xin các sư phụ chỉ giúp):
- Có phải Sub chỉ chuyên môn hoá vai trò chuyền 1 số cụ thể vào cho Funtion, không tính toán gì cả (việc tính toán là dành cho Funtion)
- Funtion chỉ chuyên tính toán dựa vào trị số do Sub cung cấp? Các biến ban đầu của Funtion ban đầu chỉ chung chung để có tính tổng quát, tính toán cụ thể phải nhờ Sub

Ví dụ Sub có dòng UniqueList2D(4, Arr1), trong khi đó khai báo Funtion có đoạn Function UniqueList2D(UniqueCol As Long, sArray), từ hai ngoặc này suy ra:

UniqueCol As Long = 4
sArray = Arr1 tức là toàn bộ vùng dữ liệu đầu vào?

 

[ptm0412]

Em thắc mắc sArray tại sao nó không được định nghĩa trước thì biết nó là vùng nào? Phải chăng nó chính là Arr1?
----------
Ví dụ Sub có dòng UniqueList2D(4, Arr1), trong khi đó khai báo Funtion có đoạn Function UniqueList2D(UniqueCol As Long, sArray), từ hai ngoặc này suy ra:

UniqueCol As Long = 4
sArray = Arr1 tức là toàn bộ vùng dữ liệu đầu vào?

Cái này mới nói hiểu hiểu bên kia, qua đây lại mơ mơ màng màng. (Nhất là sau khi nghiaphuc nói về tham số hình thức và tham số thực sự)
Đúng rồi, nàng ạ.
Tuy nhiên, phát biểu này không chính xác:

- Có phải Sub chỉ chuyên môn hoá vai trò chuyền 1 số cụ thể vào cho Function, không tính toán gì cả (việc tính toán là dành cho Function)
- Function chỉ chuyên tính toán dựa vào trị số do Sub cung cấp? Các biến ban đầu của Funtion ban đầu chỉ chung chung để có tính tổng quát, tính toán cụ thể phải nhờ Sub

Function là 1 hàm tự tạo, tạo xong nó giống như hàm Sum, hàm Count của Excel. Khi cần Sum thì dùng hàm Sum, khi cần đếm thì dùng hàm Count, khi cần lọc duy nhất 1 bảng theo 1 cột nào đó làm chuẩn, thì dùng hàm tự tạo này. Nghĩa là ta có thể tạo sẵn 1 hàm để đó, khi nào cần thì lôi ra xài. Có thể xài trực tiếp tên bảng tính, có thể dùng code VBA để xài.
Dùng hàm sum thì phải cho thằng Sum cái để nó cộng, dùng hàm Count thì phải cho nó cái để nó đếm, thì dùng hàm tự tạo cũng thế thôi! Hàm tự tạo cần cái gì thì phải cho nó cái đó!

Rộng hơn nữa, ta muốn 1 sub làm những việc sau:
- từ 1 bảng nguồn, loc duy nhất theo 1 cột nào đó thành 1 mảng,
- mảng này xào nấu thêm, thành mảng thứ 3,
- mảng thứ 3 này mới gán xuống làm kết quả.

Thì bước 1 dùng hàm này, bước 2 dùng 1 công cụ khác, hoặc hàm khác.

Vậy, dùng Sub thực hiện mục đích, Function là phương tiện phụ trợ để thực hiện mục đích, chứ không phải ngược lại.

Em muốn ứng với Giá trị cột D bằng 1 (tức cột 4) em muốn lấy Ho Cam Dao dong 9 chứ không phải Ho Cam Dao dong 8 thì làm sao hả thày?

Muốn lấy dòng nào, thì phải chỉ ra tại sao lấy dòng đó, nghĩa là chỉ ra sự khác biệt của nó đối với các dòng còn lại, chứ không nói khơi khơi. Hàm này đã viết cho bài toán cụ thể của chủ topic, là lấy duy nhất, và lấy dòng đầu tiên gặp được. Lấy dòng khác, thì phải có điều kiện để lấy mới được.

 

[70211119]

Ẹc ẹc, đã làm xong. Test 50.000 dòng mất có 0,6 giây
Nói không bằng làm, làm không bằng cho xem:

Option Base 1
Sub UniqueAndSum(sArray, ArrCols, UniqueCol, ArrSumCols)
  Dim i, j, k, h As Long, iR As Long, Tmp, ReArr()
  On Error Resume Next
  ReDim Arr(1 To UBound(sArray, 1), 1 To UBound(ArrCols))
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(sArray, 1)
      If sArray(i, UniqueCol) <> "" Then
        Tmp = sArray(i, UniqueCol)
        If Not .Exists(Tmp) Then
          iR = iR + 1
          .Add Tmp, iR
          For j = 1 To UBound(ArrCols)
            Arr(iR, j) = sArray(i, ArrCols(j))
          Next j
        Else
            For j = 1 To UBound(ArrCols)
                For k = 1 To UBound(ArrSumCols)
                If ArrCols(j) = ArrSumCols(k) Then
                    Arr(.Item(Tmp), j) = Arr(.Item(Tmp), j) + sArray(i, ArrSumCols(k))
                End If
                Next k
            Next j
        End If
      End If
    Next i
  End With
  For h = 1 To UBound(ArrCols)
    Sheet2.Cells(1, h + 6) = Sheet1.Cells(1, ArrCols(h))
  Next h
  Sheet2.Range("G2").Resize(iR, UBound(ArrCols)).Value = Arr
End Sub

Cho xem không bằng cho thử: Tải file đính kèm về chạy thử.
Cái này sửa 1 chút xíu là thành Function luôn

Tại dòng Sheet2.Range("G2").Resize(iR, UBound(ArrCols)).Value = Arr và Sheet2.Range("G2").Resize(iR, UBound(ArrCols)).Value = Arr mình thêm 1 đều kiện trong functionđể lựa chọn vị trí ghi dữ liệu được không ạ? Lúc đó hàm sẽ là UniqueAndSum Arr1, Array(2, 1, 7, 6), 2, Array(6, 7), Sheets(1).[a1]

 

[ptm0412]

Tại dòng Sheet2.Range("G2").Resize(iR, UBound(ArrCols)).Value = Arr và Sheet2.Range("G2").Resize(iR, UBound(ArrCols)).Value = Arr mình thêm 1 đều kiện trong functionđể lựa chọn vị trí ghi dữ liệu được không ạ? Lúc đó hàm sẽ là UniqueAndSum Arr1, Array(2, 1, 7, 6), 2, Array(6, 7), Sheets(1).[a1]

Được. Lúc đó thủ tục (không phải hàm) là Sub UniqueAndSum Arr1, Array(2, 1, 7, 6), 2, Array(6, 7), Rng As Range)

Sheet2.Range("G2").Resize(iR, UBound(ArrCols)).Value = Arr sửa thành

Rng.Resize(iR, UBound(ArrCols)).Value = Arr

Lưu ý:
Gọi thủ tục đến tham số Rng cần ghi rõ tên sheet