Sort mảng 1 chiều chứa chuỗi và số (1 người xem)

[mhung12005]

Thân chào các anh chị !

Tôi có mảng 1 chiều (mảng này được trả về từ Dictionary)
Bao gồm các phần tử ngày tháng và 1 phần tử chuỗi.

Tôi dùng Object("System.Collections.ArrayList") để sort mảng 1 chiều này, sau đó Transpose để gán vào list Combobox nhưng kết quả không đúng ý. Kết quả như trong file đính kèm.
Đây là code:

Sub AddZebralist()  Dim SrcArr, Arr
  Dim Dic3 As Object
  Dim lR As Long, i As Long
  Dim sTmp3 As String
 ' On Error Resume Next
  With Sheet5
    SrcArr = Sheet3.Range(Sheet3.[F2], Sheet3.[F65000].End(xlUp)).Resize(, 5).Value
    Set Dic3 = CreateObject("Scripting.Dictionary")
    Dic3.Add "All", ""
    For lR = 1 To UBound(SrcArr, 1)
      sTmp3 = CStr(SrcArr(lR, 5))
      If Len(Trim(sTmp3)) Then
        If Not Dic3.exists(sTmp3) Then Dic3.Add sTmp3, ""
      End If
    Next lR
    Arr = Dic3.keys
    With CreateObject("System.Collections.ArrayList")
      For i = 0 To UBound(Arr)
        .Add Arr(i)
      Next i
      .Sort
      Arr = .ToArray
    End With
    If IsArray(Arr) Then
        With .OLEObjects("Fixeddate").Object        '
          .Clear                                    '
          .List = Application.Transpose(Arr)
        End With
    End If
  End With
  Set Dic3 = Nothing
End Sub

Mong các bậc tiền bối chỉ giúp. Xin cảm ơn.

 

[ndu96081631]

Thân chào các anh chị !

Tôi có mảng 1 chiều (mảng này được trả về từ Dictionary)
Bao gồm các phần tử ngày tháng và 1 phần tử chuỗi.

Tôi dùng Object("System.Collections.ArrayList") để sort mảng 1 chiều này, sau đó Transpose để gán vào list Combobox nhưng kết quả không đúng ý. Kết quả như trong file đính kèm.
Đây là code:

Sub AddZebralist()  Dim SrcArr, Arr
  Dim Dic3 As Object
  Dim lR As Long, i As Long
  Dim sTmp3 As String
 ' On Error Resume Next
  With Sheet5
    SrcArr = Sheet3.Range(Sheet3.[F2], Sheet3.[F65000].End(xlUp)).Resize(, 5).Value
    Set Dic3 = CreateObject("Scripting.Dictionary")
    Dic3.Add "All", ""
    For lR = 1 To UBound(SrcArr, 1)
      sTmp3 = CStr(SrcArr(lR, 5))
      If Len(Trim(sTmp3)) Then
        If Not Dic3.exists(sTmp3) Then Dic3.Add sTmp3, ""
      End If
    Next lR
    Arr = Dic3.keys
    With CreateObject("System.Collections.ArrayList")
      For i = 0 To UBound(Arr)
        .Add Arr(i)
      Next i
      .Sort
      Arr = .ToArray
    End With
    If IsArray(Arr) Then
        With .OLEObjects("Fixeddate").Object        '
          .Clear                                    '
          .List = Application.Transpose(Arr)
        End With
    End If
  End With
  Set Dic3 = Nothing
End Sub

Mong các bậc tiền bối chỉ giúp. Xin cảm ơn.

Nếu là tôi thì tôi làm khác:

Sub AddZebralist()
  Dim SrcArr, arr
  Dim dic3 As Object, sysArrList As Object
  Dim lR As Long, lDate As Variant
  Dim sTmp3 As String
  On Error Resume Next
  Set sysArrList = CreateObject("System.Collections.ArrayList")
  Set dic3 = CreateObject("Scripting.Dictionary")
  SrcArr = Sheet3.Range(Sheet3.[F2], Sheet3.[F65000].End(xlUp)).Resize(, 5).Value
  For lR = 1 To UBound(SrcArr, 1)
    sTmp3 = CStr(SrcArr(lR, 5))
    If Len(Trim(sTmp3)) Then
      lDate = SrcArr(lR, 5)
      [COLOR=#ff0000]If IsDate(lDate) Then
        If Not dic3.Exists(lDate) Then
          dic3.Add lDate, ""
          sysArrList.Add lDate
        End If
      End If[/COLOR]
    End If
  Next lR
 [COLOR=#ff0000] sysArrList.Sort
  arr = sysArrList.ToArray[/COLOR]
  If IsArray(arr) Then
    With Sheet5.OLEObjects("Fixeddate").Object        '
      .Clear                                    '
      .List = arr
     [COLOR=#ff0000] .AddItem "All", 0[/COLOR]
    End With
  End If
  Set dic3 = Nothing: Set sysArrList = Nothing
End Sub

- Nạp phần Date, sort nó rồi nạp vào ComboBox. Cuối cùng mới nạp text cho ComboBox
- Chỉ cần 1 vòng lập: Vừa nạp dic vừa nạp ArrayList
- Với ComboBox 1 cột thì không cần TRANSPOSE

 

[mhung12005]

Nếu là tôi thì tôi làm khác:

Sub AddZebralist()
  Dim SrcArr, arr
  Dim dic3 As Object, sysArrList As Object
  Dim lR As Long, lDate As Variant
  Dim sTmp3 As String
  On Error Resume Next
  Set sysArrList = CreateObject("System.Collections.ArrayList")
  Set dic3 = CreateObject("Scripting.Dictionary")
  SrcArr = Sheet3.Range(Sheet3.[F2], Sheet3.[F65000].End(xlUp)).Resize(, 5).Value
  For lR = 1 To UBound(SrcArr, 1)
    sTmp3 = CStr(SrcArr(lR, 5))
    If Len(Trim(sTmp3)) Then
      lDate = SrcArr(lR, 5)
      [COLOR=#ff0000]If IsDate(lDate) Then
        If Not dic3.Exists(lDate) Then
          dic3.Add lDate, ""
          sysArrList.Add lDate
        End If
      End If[/COLOR]
    End If
  Next lR
 [COLOR=#ff0000] sysArrList.Sort
  arr = sysArrList.ToArray[/COLOR]
  If IsArray(arr) Then
    With Sheet5.OLEObjects("Fixeddate").Object        '
      .Clear                                    '
      .List = arr
     [COLOR=#ff0000] .AddItem "All", 0[/COLOR]
    End With
  End If
  Set dic3 = Nothing: Set sysArrList = Nothing
End Sub

- Nạp phần Date, sort nó rồi nạp vào ComboBox. Cuối cùng mới nạp text cho ComboBox
- Chỉ cần 1 vòng lập: Vừa nạp dic vừa nạp ArrayList
- Với ComboBox 1 cột thì không cần TRANSPOSE

Cảm ơn sư phụ nhiều. Đúng là không thầy đó mày làm lên.

Code của sư phụ vừa ngắn gọn (bớt 1 vòng lặp) lại vừa đạt mục đích. Em mới tập nên viết vẫn lủng củng lắm

Giờ em lại biết thêm cái AddItem của Object Combobox.

Xin hỏi thêm sư phụ điều nữa là: Em vẫn không hiểu sao Arr là mảng 1 chiều mà phương thức list của Combobox vẫn ra kết quả đúng ạ ?

 

[ndu96081631]

Xin hỏi thêm sư phụ điều nữa là: Em vẫn không hiểu sao Arr là mảng 1 chiều mà phương thức list của Combobox vẫn ra kết quả đúng ạ ?

Tại nó... vậy đấy (ai mà biết có gì trong trái ổi của anh Bill)
Nói chung là với ComboBox thì màng 2 chiều hay 1 chiều đều nạp được tuốt. Riêng với mảng 1 chiều thì thằng ComboBox nó xem như là màng 2 chiều 1 cột nhiều dòng
(listbox cũng tương tự vậy)

 

[mhung12005]

Tại nó... vậy đấy (ai mà biết có gì trong trái ổi của anh Bill)
Nói chung là với ComboBox thì màng 2 chiều hay 1 chiều đều nạp được tuốt. Riêng với mảng 1 chiều thì thằng ComboBox nó xem như là màng 2 chiều 1 cột nhiều dòng
(listbox cũng tương tự vậy)

Cảm ơn sư phụ.
Nếu không có sư phụ chỉ dẫn chắc em test mãi cũng chưa chắc "ngộ" ra được vấn đề.

 

[dhn46]

Bạn tham khảo một cách giải quyết công việc mà không dùng Dic nhé.

Sub Cbb()
    Dim cnn As Object, lsSQL As String, lrs As Object, Arr()
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    With cnn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
                          & Application.ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"";"
        .Open
    End With
    lsSQL = "Select Distinct F10 From [Temp$A2:J65536] Where Not F10 Is Null Order by F10"
    lrs.Open lsSQL, cnn, 3, 1
    With Sheet5.OLEObjects("Fixeddate").Object        '
        .Clear                                    '
        .List() = Application.WorksheetFunction.Transpose(lrs.GetRows)
        .AddItem "All", 0
    End With
    Set lrs = Nothing
    cnn.Close: Set cnn = Nothing
End Sub

 

[VetMini]

ADO dùng trên file đang mở sẽ bị hở bộ nhớ (Memory leak).

ADO chỉ hữu hiệu khi đọc file đang đóng mà thôi. Khi dùng phải lưu ý điều này.