Chỉnh thứ tự liệt kê tất cả subFolder trong Folder sử dụng Collection

thnghiachau · 10/6/20

Xin chào GPE,
Một khó khăn lớn mà mình nghĩ hoài chưa ra ah...
Mình có một code "liệt kê tất cả subFolder trong Folder sử dụng Collection"
nhưng thứ tự liệt kê mình mong muốn thế này:

Các bạn xem FIle đính kèm và giúp mình với nha.
Cám ơn nhiều.

huuthang_bd · 10/6/20

thnghiachau đã viết:
Xin chào GPE,
Một khó khăn lớn mà mình nghĩ hoài chưa ra ah...
Mình có một code "liệt kê tất cả subFolder trong Folder sử dụng Collection"
nhưng thứ tự liệt kê mình mong muốn thế này:

View attachment 239066

Các bạn xem FIle đính kèm và giúp mình với nha.
Cám ơn nhiều.

Bạn copy code lên được không? Đang xem bằng điện thoại nên không xem code trong file được.

thnghiachau · 10/6/20

huuthang_bd đã viết:
Bạn copy code lên được không? Đang xem bằng điện thoại nên không xem code trong file được.

Mình gởi code lên cho bạn coi trên dt nèn...
Cám ơn bạn nhiều lắm.

Mã:

Function ArrayAllSubFolder(ByVal strRoofFolder As String)
Dim oFSO As Object, oFolder As Object, oSubFolder As Object
Dim Queue As Collection
Dim arrSubFolder() As String, strSubFolderName As String
Dim i As Integer
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set Queue = New Collection
    Queue.Add oFSO.GetFolder(strRoofFolder)
    i = 1
    Do While Queue.Count > 0
        Set oFolder = Queue(1)
        Queue.Remove 1
        For Each oSubFolder In oFolder.SubFolders
            Queue.Add oSubFolder
            If i = 1 Then ReDim arrSubFolder(1 To 1) As String Else ReDim Preserve arrSubFolder(1 To i) As String
            If Right(oSubFolder, 1) <> "\" Then strSubFolderName = oSubFolder & "\" Else strSubFolderName = oSubFolder
            arrSubFolder(i) = strSubFolderName
            i = i + 1
        Next oSubFolder
    Loop
    ArrayAllSubFolder = arrSubFolder
End Function

Sub Test()
Dim arr
    arr = ArrayAllSubFolder("D:\Folder-1")
    Sheet1.Range("A1").Resize(UBound(arr, 1) - LBound(arr, 1) + 1) = Application.Transpose(arr)
End Sub

befaint · 10/6/20

thnghiachau đã viết:
muốn

Sort 1 cái là được cái muốn mà.

---
Vụ liệt kê này hình như có code dùng đệ quy hay lắm mà.
Làm việc với chuỗi mà dùng Application.Transpose() thì hơi nguy hiểm.

VetMini · 10/6/20

befaint đã viết:
Sort 1 cái là được cái muốn mà.
---
Vụ liệt kê này hình như có code dùng đệ quy hay lắm mà.
Làm việc với chuỗi mà dùng Application.Transpose() thì hơi nguy hiểm.

1. Đã chép xuông sheet rồi thì sort quá tiện. Thớt viết đượ cả cái code hoành tráng vậy mà chỉ có sort cũng "nghĩ hoài không ra". Quả là trường hợp đầu óc nghĩ xa quá cho nên cái gần trước mắt khong thấy.
2. Đệ quy rắc rối và chậm hơn.
3. Transpose có giới hạn của nó, không chỉ trên chuỗi, mà trên số lượng phần tử nữa. Đối với dân diễn đàn này thì chuyện "dữ liệu khủng" là điều "thường xuyên" xảy ra.

thnghiachau · 10/6/20

VetMini đã viết:
1. Đã chép xuông sheet rồi thì sort quá tiện. Thớt viết đượ cả cái code hoành tráng vậy mà chỉ có sort cũng "nghĩ hoài không ra". Quả là trường hợp đầu óc nghĩ xa quá cho nên cái gần trước mắt khong thấy.
2. Đệ quy rắc rối và chậm hơn.
3. Transpose có giới hạn của nó, không chỉ trên chuỗi, mà trên số lượng phần tử nữa. Đối với dân diễn đàn này thì chuyện "dữ liệu khủng" là điều "thường xuyên" xảy ra.

Cám ơn anh cho em cái hướng dẫn ích lợi... nhất là cái số 3. ah!
Thực chất là em viết ra để hỏi GPE nên em chỉ lấy ra cái cốt lõi như thê thôi, chứ thực tế là em muốn ra thứ tự mong muốn như đã hỏi và làm việc liệt kê các file trong từng subFolder ah. Vì khi làm xong em phải điều chỉnh lại nên hơi cực! và em cũng đã sort kết quả subFolder như anh @befaint đã nói, nhưng khi đó là mình phải tạo ra list SubFolder-> rồi Sort -> rùi quay lại từng cái SubFolder để liệt kê file .... nên em muốn theo thứ tự đó mà làm luôn chứ không phải ra cái list subFolder nữa...
Ah nhân tiện về cái dzụ Application.Transpose anh có thể gởi em cái gì em nghiên cứ thêm không ạ? vì em chưa đi học bất cứ trường lớp nào từ đó giờ toàn là tự làm tự tìm hiểu mà ra thôi nên em rất còn hạn chế trong kiến thức... Khổ là tại e thích quá nên lao vào thôi! và khi biết thì có những cái ứng dụng làm mình thích thêm!!! Cám ơn anh nhiều lắm.

Hau151978 · 10/6/20

Nếu có 2 folder tên là "a" và "a-", trong folder a có subfolder "a" (không có dấu nháy kép) thì liệt kê ra sẽ được:

Mã:

a
a-
a\a

Sau khi sort vẫn giữ nguyên kết quả trên vì mã ASCII của ký tự "-" là 45 trong khi của "\" là 92.

thnghiachau · 10/6/20

Hau151978 đã viết:
Nếu có 2 folder tên là "a" và "a-", trong folder a có subfolder "a" (không có dấu nháy kép) thì liệt kê ra sẽ được:

Mã:

a a- a\a

Sau khi sort vẫn giữ nguyên kết quả trên vì mã ASCII của ký tự "-" là 45 trong khi của "\" là 92.

Sort đôi lúc có sự tương đối trong đó thì phải!!!

Hau151978 · 10/6/20

thnghiachau đã viết:
Sort đôi lúc có sự tương đối trong đó thì phải!!!

Vẫn làm đúng được mà bạn. Bạn khai báo biến dictionary hoặc array cấp độ module chứa kết quả. Dùng đệ quy là được.

thnghiachau · 10/6/20

Hau151978 đã viết:
Vẫn làm đúng được mà bạn. Bạn khai báo biến dictionary hoặc array cấp độ module chứa kết quả. Dùng đệ quy là được.

Hic ... "Đệ qui" thì mình potay... nhưng sẽ nghiên cứu...

huuthang_bd · 11/6/20

Code của bạn sửa lại như sau.

Mã:

Function ArrayAllSubFolder(ByVal strRoofFolder As String)
Dim oFSO As Object, oFolder As Object, oSubFolder As Object
Dim Queue As Collection
Dim arrSubFolder() As String, strSubFolderName As String
Dim i As Long, n As Long
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set Queue = New Collection
    Queue.Add oFSO.GetFolder(strRoofFolder)
    ReDim arrSubFolder(0 To 0)
    Do While Queue.Count > 0
        n = Queue.Count
        Set oFolder = Queue(n)
        For Each oSubFolder In oFolder.SubFolders
            Queue.Add oSubFolder, , , n
        Next
        ReDim Preserve arrSubFolder(0 To i) As String
        arrSubFolder(i) = oFolder.Path
        i = i + 1
        Queue.Remove n
    Loop
    ArrayAllSubFolder = arrSubFolder
End Function

thnghiachau · 11/6/20

huuthang_bd đã viết:

Code của bạn sửa lại như sau.

Mã:

Function ArrayAllSubFolder(ByVal strRoofFolder As String)
Dim oFSO As Object, oFolder As Object, oSubFolder As Object
Dim Queue As Collection
Dim arrSubFolder() As String, strSubFolderName As String
Dim i As Long, n As Long
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set Queue = New Collection
    Queue.Add oFSO.GetFolder(strRoofFolder)
    ReDim arrSubFolder(0 To 0)
    Do While Queue.Count > 0
        n = Queue.Count
        Set oFolder = Queue(n)
        For Each oSubFolder In oFolder.SubFolders
            Queue.Add oSubFolder, , , n
        Next
        ReDim Preserve arrSubFolder(0 To i) As String
        arrSubFolder(i) = oFolder.Path
        i = i + 1
        Queue.Remove n
    Loop
    ArrayAllSubFolder = arrSubFolder
End Function

Dạ cám ơn anh, để em dùng code anh thử nha....

--------------

Ohhh... tuyệt cú mèo anh ơi... em chạy code mà sướng tê người... cám ơn anh lần nữa nha!!!!

VetMini · 12/6/20

Hau151978 đã viết:
Nếu có 2 folder tên là "a" và "a-", trong folder a có subfolder "a" (không có dấu nháy kép) thì liệt kê ra sẽ được:

Mã:

a a- a\a

Sau khi sort vẫn giữ nguyên kết quả trên vì mã ASCII của ký tự "-" là 45 trong khi của "\" là 92.

Tôi theo quy luật "If it ain't broke, don't fix it" (nếu chưa hỏng thì đừng đụng vào).
Mấy cái công việc nhỏ nhoi này cần thêm gì cứ thêm, sửa code chi cho mệt.
Trước khi sort, thay tất cả các ký tự "\" thành Char(9)/Tab. Sort xong thay lại.

Đệ quy: cái này hồi xưa tôi làm trong VBS.

Sub ListFolders()
Dim aList(1 To 100000, 1 To 2), aListN As Long
With CreateObject("Scripting.FileSystemObject")
CollateSubFolders .GetFolder("C:\đống rác của tôi"), aList, aListN
End With
Sheet1.Range("a1").Resize(aListN, 2) = aList
End Sub

Sub CollateSubFolders(ByRef Folder, ByRef aList, ByRef aListN As Long)
For Each Subfolder In Folder.SubFolders
aListN = aListN + 1
aList(aListN, 1) = Subfolder.Path
aList(aListN, 2) = Subfolder.Attributes
CollateSubFolders Subfolder, aList, aListN
Next
End Sub

thnghiachau · 13/6/20

VetMini đã viết:
Tôi theo quy luật "If it ain't broke, don't fix it" (nếu chưa hỏng thì đừng đụng vào).
Mấy cái công việc nhỏ nhoi này cần thêm gì cứ thêm, sửa code chi cho mệt.
Trước khi sort, thay tất cả các ký tự "\" thành Char(9)/Tab. Sort xong thay lại.

Đệ quy: cái này hồi xưa tôi làm trong VBS.

Sub ListFolders()
Dim aList(1 To 100000, 1 To 2), aListN As Long
With CreateObject("Scripting.FileSystemObject")
CollateSubFolders .GetFolder("C:\đống rác của tôi"), aList, aListN
End With
Sheet1.Range("a1").Resize(aListN, 2) = aList
End Sub

Sub CollateSubFolders(ByRef Folder, ByRef aList, ByRef aListN As Long)
For Each Subfolder In Folder.SubFolders
aListN = aListN + 1
aList(aListN, 1) = Subfolder.Path
aList(aListN, 2) = Subfolder.Attributes
CollateSubFolders Subfolder, aList, aListN
Next
End Sub

Dạ cám ơn anh... đúng lúc e đang nghiên cứu cái này ah

VetMini · 13/6/20

Nghiên cứu quái gì.
Cái bạn muốn là màu mè mẫu mã.
Đệ quy thuộc về ký thuyết lập trình, dân màu mè không cần phải học.

thnghiachau · 13/6/20

VetMini đã viết:
Nghiên cứu quái gì.
Cái bạn muốn là màu mè mẫu mã.
Đệ quy thuộc về ký thuyết lập trình, dân màu mè không cần phải học.

Dạ, anh không cần học chứ e thì cái gì cũng phải học hết ah... vì e không giỏi nên lại càng phải học.... mà đã giỏi thì em lại càng muốn học để giỏi hơn....

thnghiachau · 18/6/20

VetMini đã viết:
3. Transpose có giới hạn của nó, không chỉ trên chuỗi, mà trên số lượng phần tử nữa. Đối với dân diễn đàn này thì chuyện "dữ liệu khủng" là điều "thường xuyên" xảy ra.

Chào anh @VetMini , sao chỉ dẫn này của anh, em đã biết và thử kiểm tra về cái dzụ Transpose ah...
Đúng là cái Transpose này có giới hạn và nguy hiểm nhiều thiệt. nếu trên 65537 rows thì bị lỗi.
Sau thời gian google và tìm hiểu thì em có dc cái "Function MyTranspose" riêng để không bị lỗi khi dự liệu nhiều

Mã:

'Collect from "https://www.excelforum.com/"
Function MyTranspose(ByVal inArr As Variant) As Variant
Dim i As Long, ii As Long, j As Long
Dim outArr() As Variant, OneDArr() As Variant
On Error Resume Next
    If UBound(inArr, 2) = 0 Then
        On Error GoTo 0
'###Case 1 ) Input Array is array 1D "pseudo" horizontal Array.
        ReDim outArr(1 To ((UBound(inArr) - LBound(inArr)) + 1), 1 To 1)
        For ii = LBound(inArr) To UBound(inArr) Step 1
            Let i = i + 1
            Let outArr(i, 1) = inArr(ii)
        Next ii
        Let MyTranspose = outArr()
    Else
        ReDim outArr(1 To UBound(inArr, 2), 1 To UBound(inArr, 1))
'###Case 2 ) Input Array is 1 column 2D l Array...
        If UBound(inArr, 2) = 1 Then
            ReDim OneDArr(1 To UBound(inArr, 1))
            For j = 1 To UBound(inArr, 1)
                Let OneDArr(j) = inArr(j, 1)
            Next j
            Let MyTranspose = OneDArr()
        Else
'###Case3) Input Array has more than 1 Column
            For j = 1 To UBound(inArr, 1)
                For i = 1 To UBound(inArr, 2)
                    Let outArr(i, j) = inArr(j, i)
                Next i
            Next j
            Let MyTranspose = outArr()
        End If
    End If
On Error GoTo 0
End Function

Với cái này em thử thấy OK ah. Mong các bạn trên GPE này kiểm tra giúp thật sự OK chưa và mọi người có thể dùng trong các ứng dụng code của mình .
Cám ơn nhiều.

huuthang_bd · 18/6/20

Vài dòng nhận xét:

Chỉ số trên của chiều thứ 2 bằng 0 đâu phải là mảng 1 chiều.
Đâu phải chỉ số trên của chiều thứ 2 bằng 1 là mảng có 1 cột.
Đâu phải chỉ số dưới các chiều của mảng 2 chiều luôn là 1.

thuyyeu99 · 18/6/20

Cái Transpose này hình như trong diễn đàn có đó. bạn tìm tham khảo thử xem

thnghiachau · 18/6/20

huuthang_bd đã viết:
Vài dòng nhận xét:

Chỉ số trên của chiều thứ 2 bằng 0 đâu phải là mảng 1 chiều.

Đâu phải chỉ số trên của chiều thứ 2 bằng 1 là mảng có 1 cột.

Đâu phải chỉ số dưới các chiều của mảng 2 chiều luôn là 1.

Dạ, cám ơn thầy, em sẽ tìm hiểu và chỉnh lại mấy điều trên ạ.

Chỉnh thứ tự liệt kê tất cả subFolder trong Folder sử dụng Collection

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

File đính kèm

Chuyên gia GPE

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

|||||||||||||

Ăn cùng góc phố

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên tích cực

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên tích cực

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Chuyên gia GPE

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Ăn cùng góc phố

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Ăn cùng góc phố

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Chuyên gia GPE

Trùm Nhiều Chuyện

Chỉ biết ngồi BÈ và PHÁN chuyện!!!