Vui Chơi Với Thuật Toán Đệ Quy Trong Lập Trình Với Excel

Chia sẻ bởi:hands

★★★★★

‹ Hướng Dẫn Sử Dụng Function UniVBA và... Một số thuật toán về sort mảng ›

Quảng cáo

Tình hình là mấy ngày nay Mình đang nghiên cứu ứng dụng thuật Toán đệ Quy trong VBA một tí …Có đọc rất nhiều bài trên GPE và Goolge để nghiên cứu xem tình hình sao…

Thấy bài trên GPE rất nhiều nhưng ứng dụng và bài viết cũng ít …

Mình có nghiên cứu nhưng chưa thật sự hiểu sâu lắm về thuật Toán đệ quy lắm….Vây Mình lập ra đề tài này để mình học hỏi và nghiên cứu thêm …

Nếu Bạn nào có hứng với thuật Toán đệ quy và có thắc mắc gì thì cứ úp Bài chung vào đây càng nhiều càng tốt ta cùng nhau vui chơi cho thỏa thích…–=0

Mạnh là nông dân thuần túy thích thì vọc chơi nên thuật ngữ chuyên nghành về lập trình phát biểu không giống ai … Mong các Bạn có Kiến thức Hàm lâm chỉ thêm chứ không nên bắt bẻ nọ kia …xin cảm ơn

Sẽ có nhiều bài ứng dụng thuật toán đệ quy trong Thớt này …từ từ ta cùng nhau ngâm cứu

Ứng dụng duyệt File trong Folder và SubFolders Open File
Public Sub OpenFilesInSubFolder(ByVal sFolder As String, ByVal InSub As Boolean)
    Dim objsFolder As Object, ObjFile As Object
    With CreateObject("Scripting.FileSystemObject")
        For Each ObjFile In .GetFolder(sFolder).Files
            If .GetExtensionName(ObjFile) Like "xls*" Then
                If Left(ObjFile.Name, 2) <> "~$" Then
                    If ObjFile.Name <> ThisWorkbook.Name Then
                        With Workbooks.Open(ObjFile)
                            .Close False
                        End With
                    End If
                End If
            End If
        Next ObjFile
        If InSub Then
            For Each objsFolder In .GetFolder(sFolder).subFolders
                Call OpenFilesInSubFolder(objsFolder.Path, True)
            Next objsFolder
        End If
    End With
End Sub

''False = Open File Trong Folder       ==> không đệ Quy
''True = Open File Trong SubFolders ==> Đệ Quy

Public Sub Main()
    Dim Path As String
    Path = ThisWorkbook.Path
    OpenFilesInSubFolder Path, True
End Sub
Với code trên nếu Sub Main mà là False thì sẻ mở hết tất cả các File Excel trong Folder đó …Còn True thì sẻ mở hết Từ Folder cha, con, cháu … trong Folder cha…

Nếu Các Bạn có cách nào viết khác xin được chỉ thêm….

Rất mong các Bạn tham gia xem cách Viết như vậy có vấn đề gì không…
Nếu Ok bài sau ta sẻ ứng dụng nó tổng hợp các File trong Folder cha, con, cháu chắt nhà nó….

Sau nữa thì ta chơi qua ADO….
……………………………
Xin cảm ơn Các bạn đã tham gia

Chúc Vui Chơi Trí Tuệ , Hòa Bình & Vui Vẻ
Ứng dụng code Bài 1 Tổng hợp dữ liệu trong Folder Cha,con, cháu chắt nhà nó…

Nếu Bạn nào có cách Viết khác hay thì cũng xin Mời…

1/ Trong Folder cha có nhiều Folder là tiếng việt có dấu….số lượng Folder không xác định..

2/ Tên File là Tiếng việt có dấu …Tên File và số lượng File trong Folder cha con cháu chắt không Xác định

3/ Biết được Tên Sheet và vùng dữ liệu cần tổng hợp là: Sheets("THU").Range("A6:J1000")

4/ Tổng số dòng của các Sheet trong Folder cha , con … cộng lại không Vượt quá số dòng của một Sheet khi nó gán xuống cộng lại …. nếu quá thì tèo téo teo là đương nhiên không Bàn cải

5/ Vậy Code Tổng hợp tất cả các File trong Folder cha,con, cháu chắt nhà nó …

File nào có tên Sheet như trên thì lấy …Gán lên Sheet Tonghop của File Tonghop như thế nào xin mời các Bạn tham gia Code…

Nếu code chạy đúng nó có 150 dòng …(Giả lập để test chỉ cần ít vậy thôi)

Xong Bài này ta nâng cấp vồ vồ lên …xong ta chơi qua ADO …cũng vồ vồ luôn…Thích ta lại chơi tiếp

File và Folder giả lập
Thân

Chơi kèm file mà không có code vậy bạn hiền???

Từ từ Bạn Hiền ….Bạn code khai phá trước cho Mạnh Cái đi…

Thích thì chiều

Dim dArr(1 To 100000, 1 To 10)
Dim I As Long, X As Long, J As Long

Function Getfile(ByVal Linkfolder As String)
Dim sfi As Object, fi  As Object, oFolder As Object, Wb As Workbook, Sh As Worksheet, Arr
Static fso As Object, pFile As String
pFile = ActiveWorkbook.Name
If fso Is Nothing Then Set fso = CreateObject("Scripting.filesystemobject")
Set oFolder = fso.GetFolder(Linkfolder)
For Each fi In oFolder.Files
If fso.GetExtensionName(fi) Like "*xls*" Then
    If Left(fi.Name, 1) <> "~" Then
    If InStr(1, fi.Name, pFile) <= 0 Then
        Set Wb = Workbooks.Open(fi.Path)
        For Each Sh In Wb.Worksheets
        If Sh.Name = "THU" Then
        Set Sh = Wb.Sheets("THU")
        Arr = Sh.Range("B6", Sh.Range("B65000").End(3)).Resize(, 9).Value
            For X = 1 To UBound(Arr)
                If Len(Arr(X, 1)) Then
                    I = I + 1
                    dArr(I, 1) = I
                    For J = 1 To 9
                        dArr(I, J + 1) = Arr(X, J)
                    Next J
                End If
            Next X
        End If
        Next Sh
        Workbooks(fi.Name).Close
    End If
    End If
End If
Next fi
For Each sfi In oFolder.SubFolders
    Getfile (sfi)
Next
End Function

Sub Muon_XXX()
Application.ScreenUpdating = False
    Dim source As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        .AllowMultiSelect = False
        source = .SelectedItems(1)
    End With
    I = 0
    Getfile (source)
    Sheet1.Range("A2:J65536").ClearContents
    Sheet1.Range("A2").Resize(I, 10) = dArr
Application.ScreenUpdating = True
End Sub

www.giaiphapexcel.com/diendan/threads/vui-ch%C6%A1i-v%E1%BB%9Bi-thu%E1%BA%ADt-to%C3%A1n-%C4%90%E1%BB%87-quy-trong-l%E1%BA%ADp-tr%C3%ACnh-v%E1%BB%9Bi-excel.113592/

Biết nói sao với bình phẩm thế này nhỉ? |||||
Đệ quy đúng nghĩa mà tôi muốn nói với anh/chị là đây:
Dim TotalOfFolders

Sub OpenFilesInSubFolder(sFolder As String, Level As Long)
    Dim subFolder As Object, ObjFile As Object
    With CreateObject("Scripting.FileSystemObject")
        For Each ObjFile In .GetFolder(sFolder).Files
            If .GetExtensionName(ObjFile) Like "*pdf" Then
                If Left(ObjFile.Name, 2) <> "~$" Then
                    'Debug.Print ObjFile.Name
                End If
            End If
        Next

For Each subFolder In .GetFolder(sFolder).subFolders
            If Level > 1 Then
                OpenFilesInSubFolder subFolder.Path, Level - 1
            End If

Debug.Print Level & ">" & subFolder.Path
            TotalOfFolders = TotalOfFolders + 1
        Next
    End With
End Sub

Sub Main()
    TotalOfFolders = 0
    OpenFilesInSubFolder "D:Program Files", 999
    Debug.Print TotalOfFolders
End Sub
Khi dùng cái Sub này bạn sẽ nhận được:

Kiểm soát được mức sâu của cấu trúc thư mục bạn muốn quét thay vì quét đến toàn bộ hoặc chỉ quét được cấp 1. Ví dụ tôi muốn quét tối đa 3 cấp tôi nhập level = 3, muốn quét 5 cấp level = 5, muốn quét toàn bộ level =999999999999999. Hiển nhiên Level chỉ là con số kỳ vọng, cấp độ thư mục có thể được chia ít hơn.

Phân biệt đúng cấp (lớp)của folder. Level càng cao thì càng gần thư mục gốc. Các folder cùng level nghĩa là cùng cấp (có thể khác nhánh)

Còn cái vụ Count j đó thì cũng chẳng cần thiết vì foreach đủ thông minh để tự văng ra khi chẳng có subfolder nào. Anh/chị nào hay debug F8 thì cái này chắc sẽ biết.

Tôi test thử cái đệ quy đúng nghĩa này với folder có tổng cộng 1400 folder con rồi. Chú ý là folder con không có thuộc tính hidden/system nhé. Trình độ có hạn nên xin nhường lại cho các cao thủ ở đây.|||||
Mình mới Test OK … Cảm ơn Bạn Mình học Thêm một cách hay…