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

Liên hệ QC

Kiều Mạnh

I don't program, I beat code into submission!!!
Tham gia
9/6/12
Bài viết
5,541
Được thích
4,125
Giới tính
Nam
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
Mã:
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ẻ

Thân
 
Lần chỉnh sửa cuối:
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
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ẻ

Thân
Gợi ý chơi thôi nha, Trong sub ở trên nếu đã sử dụng đệ quy thì sẽ không có vòng lặp làm gì. đệ quy là gì? chẳng qua là quay lại làm y chang với cái thằng cha sinh ra nó thôi
 
Upvote 0
Gợi ý chơi thôi nha, Trong sub ở trên nếu đã sử dụng đệ quy thì sẽ không có vòng lặp làm gì. đệ quy là gì? chẳng qua là quay lại làm y chang với cái thằng cha sinh ra nó thôi
Vậy nếu Không sử dụng vòng lập thì trong Folder cháu chắt ta làm sao....

Mong Bạn cho Một Code học tập để Mạnh khai mở thêm một tí ...
 
Upvote 0
Vậy nếu Không sử dụng vòng lập thì trong Folder cháu chắt ta làm sao....

Mong Bạn cho Một Code học tập để Mạnh khai mở thêm một tí ...
Folder cháu chắc cũng giống như folder cha và ông nội vậy, nên anh kiều mạnh cứ suy nghĩ xem sao, tất cả chúng điều có 1 điểm chung là
folder cha chứa nhiều file và folder con,
folder con chứa nhiều file và foder cháu
fofder cháu chứa nhiều file và folder chắc
.....
lập luận như vậy thì sẽ sử dụng được đệ quy thôi
đệ quy là cái mà thay thế cho vòng lặp, và có những bài toán không thể sử dụng vòng lặp giải quyết, từ đó mới sinh ra đệ quy để giải quyết vấn đề đấy chứ
(thông cảm em không code nha)
 
Upvote 0
Folder cháu chắc cũng giống như folder cha và ông nội vậy, nên anh kiều mạnh cứ suy nghĩ xem sao, tất cả chúng điều có 1 điểm chung là
folder cha chứa nhiều file và folder con,
folder con chứa nhiều file và foder cháu
fofder cháu chứa nhiều file và folder chắc
.....
lập luận như vậy thì sẽ sử dụng được đệ quy thôi
đệ quy là cái mà thay thế cho vòng lặp, và có những bài toán không thể sử dụng vòng lặp giải quyết, từ đó mới sinh ra đệ quy để giải quyết vấn đề đấy chứ
(thông cảm em không code nha)

anh ơi , tụi em dốt và chậm hiểu lắm . Xin anh chiếu cố cho tụi em vài dòng code đệ quy thay thế vòng lặp ở #1 đi anh . Chứ anh nói vậy tụi em chưa có hình dung ra được . Cảm ơn anh .
 
Upvote 0
Hình như code này khởi tạo rất nhiều object. Để an toàn, ta nên set =nothing ở cuối thủ tục.
 
Upvote 0
cái đó có mình có gải thích bài 1 rồi mà ... mình làm vậy để tùy biến thôi
Tôi thấy như thế thì đâm ra lưỡng tính, true mới đệ quy, false chẳng pải đệ quy. Đệ quy bản thân nó tự nhiên lắm, cứ chạy, phân nhánh... đến khi nào tới kỳ cùng thì thôi.
Chắc là anh/chị sợ nó chạy đến kỳ cùng thì bung ra cả đống --=0. Nếu vậy thì mình có thể đưa ra giới hạn số tầng được quét đệ quy. Ví dụ quét đến tầng thứ 3: cha -> con -> cháu. Còn tương đương với Insub = true thì quét tầng 1 là cha thôi. Đại khái truyền tham số kiểu:
PHP:
OpenFilesInSubFolder(ByVal sFolder As String, ByVal Level As Long)
và khi đệ quy ta có
PHP:
...
OpenFilesInSubFolder subFolder, Level - 1
...
Đây mới là đệ quy đúng nghĩa.
 
Lần chỉnh sửa cuối:
Upvote 0
Tôi thấy như thế thì đâm ra lưỡng tính, true mới đệ quy, false chẳng pải đệ quy. Đệ quy bản thân nó tự nhiên lắm, cứ chạy, phân nhánh... đến khi nào tới kỳ cùng thì thôi.
Chắc là anh/chị sợ nó chạy đến kỳ cùng thì bung ra cả đống --=0. Nếu vậy thì mình có thể đưa ra giới hạn số tầng được quét đệ quy. Ví dụ quét đến tầng thứ 3: cha -> con -> cháu. Còn tương đương với Insub = true thì quét tầng 1 là cha thôi. Đại khái truyền tham số kiểu:
PHP:
OpenFilesInSubFolder(ByVal sFolder As String, ByVal Level As String)
và khi đệ quy ta có
PHP:
...
OpenFilesInSubFolder subFolder, Level - 1
...
Đây mới là đệ quy đúng nghĩa.
Trong 1 cây thư mục không biết max level là bao nhiêu thì sao? Ở bài 1 nên thêm lệnh kiểm tra subfolders.count=0 tức là không có thư mục con nào chính là điểm dừng.
 
Lần chỉnh sửa cuối:
Upvote 0
Trong 1 cây thư mục không biết max level là bao nhiêu thì sao? Ở bài 1 nên thêm lệnh kiểm tra subfolders.count=0 tức là không có thư mục con nào chính là điểm dừng.
Nếu bạn muốn liệt kê dây mơ rễ mã cả nhà anh folder ra à? Thử nhập level = 9999 hoặc 9999999999 xem có ra đầy đủ không nhé. (Thực tế thì cũng chả ai rảnh rỗi phân thư mục quá cỡ 9 lớp cả --=0)
 
Lần chỉnh sửa cuối:
Upvote 0
Upvote 0
Thôi thì ai muốn bàn le vồ hay vồ vồ gì đó thì cứ bàn Ta chơi cái mới ...--=0

Ứ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
 

File đính kèm

  • Test DeQuy.rar
    137.5 KB · Đọc: 20
Lần chỉnh sửa cuối:
Upvote 0
Thôi thì ai muốn bàn le vồ hay vồ vồ gì đó thì cứ bàn Ta chơi cái mới ...--=0
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:
Mã:
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:
  1. 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.
  2. 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.|||||
 
Lần chỉnh sửa cuối:
Upvote 0
Thích thì chiều

Mã:
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
Mã:
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
Bạn test lai chua Nó Không Select Folder
 
Upvote 0
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:
Mã:
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:
  1. 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.
  2. 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...
 
Upvote 0
Mạnh Xin mượn code bài #18 Của Bạn Vô danh tiểu tốt ... trả lời cho đáp án bài 14 của Mình....

Nếu Bạn nào có cách nào khác hay và gắn gọn hơn thì xin mời code...Tiếp

Thay vì mình sử dụng code bài #1 cũng OK nhưng Mình khám phá cái mới xem tình hình sao....|||||--=0

Mã:
Dim TotalOfFolders
Public Sub OpenFilesInSubFolders(ByVal sFolder As String, ByVal Level As Long)
Application.ScreenUpdating = False
    Dim subFolder As Object, ObjFile As Object
    Dim Sh As Worksheet, Arr(), Target As Worksheet
    Set Target = Sheets("TongHop")
    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)
                            For Each Sh In .Worksheets
                                If Sh.Name = "THU" Then
                                    Arr = Sh.Range("A6", Sh.[A1000].End(3)).Resize(, 10).Value
                                    Target.Range("A65536").End(3)(2).Resize(UBound(Arr), 10) = Arr
                                End If
                            Next
                            .Close False
                        End With
                    End If
                End If
            End If
        Next
        For Each subFolder In .GetFolder(sFolder).subFolders
            If Level > 1 Then
                OpenFilesInSubFolders subFolder.Path, Level - 1
            End If
            TotalOfFolders = TotalOfFolders + 1
        Next
    End With
Application.ScreenUpdating = True
End Sub


Public Sub Main()
    Dim Path As String
    ActiveSheet.UsedRange.ClearContents
    Path = ThisWorkbook.Path
    OpenFilesInSubFolders Path, 999
End Sub
 
Upvote 0
Trả lời cho đáp án code Bài 14 Của mình
Mã:
Public Sub TongHop(ByVal sFolder As String, ByVal InSub As Boolean)
Application.ScreenUpdating = False
    Dim objsFolder As Object, ObjFile As Object
    Dim Sh As Worksheet, Arr(), Target As Worksheet
    Set Target = Sheets("TongHop")
    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)
                            For Each Sh In .Worksheets
                                If Sh.Name = "THU" Then
                                    Arr = Sh.Range("A6", Sh.[A1000].End(3)).Resize(, 10).Value
                                    Target.Range("A65536").End(3)(2).Resize(UBound(Arr), 10) = Arr
                                End If
                            Next
                            .Close False
                        End With
                    End If
                End If
            End If
        Next ObjFile
        If InSub Then
            For Each objsFolder In .GetFolder(sFolder).subFolders
                Call TongHop(objsFolder.Path, True)
            Next objsFolder
        End If
    End With
Application.ScreenUpdating = True
End Sub


Public Sub Main_TongHop()
    Dim Path As String
    ActiveSheet.UsedRange.ClearContents
    Path = ThisWorkbook.Path
    TongHop Path, True
End Sub

Mình xin mượn code bài #18 quậy một tẹo khám phá cái mới xem tình Hình sao..|||||--=0
Mã:
Dim TotalOfFolders
Public Sub OpenFilesInSubFolders(ByVal sFolder As String, ByVal Level As Long)
Application.ScreenUpdating = False
    Dim subFolder As Object, ObjFile As Object
    Dim Sh As Worksheet, Arr(), Target As Worksheet
    Set Target = Sheets("TongHop")
    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)
                            For Each Sh In .Worksheets
                                If Sh.Name = "THU" Then
                                    Arr = Sh.Range("A6", Sh.[A1000].End(3)).Resize(, 10).Value
                                    Target.Range("A65536").End(3)(2).Resize(UBound(Arr), 10) = Arr
                                End If
                            Next
                            .Close False
                        End With
                    End If
                End If
            End If
        Next
        For Each subFolder In .GetFolder(sFolder).subFolders
            If Level > 1 Then
                OpenFilesInSubFolders subFolder.Path, Level - 1
            End If
            TotalOfFolders = TotalOfFolders + 1
        Next
    End With
Application.ScreenUpdating = True
End Sub


Public Sub Main2()
    Dim Path As String
    ActiveSheet.UsedRange.ClearContents
    Path = ThisWorkbook.Path
    OpenFilesInSubFolders Path, 999
End Sub

Mời Các Bạn Test dùm
Cảm ơn Bạn Vô danh tiểu tốt nhiều nhiều
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom