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

5 Responses

1. hands says:

   17/01/2023 at 9:04 am

   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

   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

   Trả lời cho đáp án code Bài 14 Của mình

   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

   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

   1. Đệ quy đơn giản chỉ là sử dụng hàm đấy trong chính thân hàm đó thôi. ứng dụng thì có thể là duyệt thư mục, tính giai thừa… Đệ quy làm đầy rất nhanh stack, vì vậy dùng nó phải kiểm soát đc độ sâu gọi nó. Trong java android, độ sâu thì khoảng 100 là tạch, PC thì lớn hơn.
   2. Về code duyệt thư mục của bạn, nếu bạn thừ duyệt thư mục System32 xem, lâu đấy. Mình thấy nên sử dụng các hàm API trực tiếp của Windows ( các hàm FindFirstFile/FindNextFile/FindClose ) sẽ cho kết quả nhanh hơn.

   Mình cũng khoái API lắm ….Nhưng API với mình tịt toàn Tập có chăng Copy của ai đó thấy phù hợp với công việc xong độ lại một tí chơi vậy thôi chứ ….

   Thật lòng phải nói ra nhưng dòng trên thấy cũng ngài ngại sao ý …-\/.-\/.

   Nếu được mong Bạn cho 1 code để mình học hỏi
   xin cảm ơn

   Gì vậy bồ. Thì tôi để lúc chạy code cho chủ động chọn folder mà…muốn thì set cứng đường dẫn chứ lị

   Dim dArr(1 To 65000, 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
   source = ThisWorkbook.Path
       I = 0
       Getfile (source)
   With Sheets("TongHop")
       .Range("A2:J65536").ClearContents
       .Range("A2").Resize(I, 10) = dArr
   End With
   Application.ScreenUpdating = True
   End Sub

   Lúc nảy thử vậy OK rồi Bạn Hiền

   Sub XYZ()
       Dim source As String
       source = ThisWorkbook.Path
       Getfile (source)
       Sheet1.Range("A2:J65536").ClearContents
       Sheet1.Range("A2").Resize(I, 10) = dArr
   End Sub

   Hình như ít Bạn có hứng với Thuật Toán Đệ Quy thì phải…–=0

   Với yêu cầu như bài #14 …. Files và Folder Giả lập như Bài #14 ta sử dụng VBA thì thấy nó đơn giản …thôi bỏ qua….giờ ta chuyển qua ADO

   1/ Sử dụng ADO tổng hợp tất cả các Sheets("THU") trong Folder như đã từng làm bằng VBA trong mấy bài trước…. (Bài này cũng khó hơn VBA một tẹo thôi…)

   2/ Sử dụng ADO tổng hợp hết tất cả các Files và tất cả các sheets trong File từ Thư mục cha cho đến thư mục con cháu không xác định tên Sheets ….Gán lên Sheet nếu đúng thì sẻ có 457 dòng….(Bài này thì cũng đau đầu á…+-+-+-+!$@!!–=0)

   3/ Lưu ý không sử dụng On Error … để xử lý lỗi…..(Mạnh thì đang nhức đầu khúc này+-+-+-+!$@!!)

   Nếu Bạn nào có nhả hứng thì tham gia code…
   xin cảm ơn

   Reply
2. hands says:

   17/01/2023 at 9:15 am

   Mình không biết diễn giải về đệ quy, mặc dù cũng cố lắm lắm nhưng cũng chỉ viết ra code này. Cũng tạm gọi là đệ quy chút chút. Theo mình hiểu, đệ quy là dùng 1 thủ tục hoặc 1 hàm nào đó và gọi lại chính nó. Nói chung là phức tạp bỏ xừ.

   Sub ArraySort()
   'Written by QuangHai
   Dim Data(), Temp As String
   Dim FirsrtRow As Long, FirstCol As String, SortOrder()
   Dim TotalCols As Byte, Row As Long, J As Long
   SortOrder = Array(2, 3)
   With Sheets("Nguon")
   Data = .Range("A3", ..End(3)).Value
   End With
   TotalCols = UBound(Data, 2)
   ReDim Preserve Data(1 To UBound(Data), 1 To (TotalCols + 1))
   For Row = 1 To UBound(Data, 1)
   For J = 0 To UBound(SortOrder)
   If IsDate(Data(Row, SortOrder(J))) Then
   Temp = Temp & CLng(Data(Row, SortOrder(J)))
   Else
   Temp = Temp & Space(2) & Format(Data(Row, SortOrder(J)), String(15, "0"))
   End If
   Next
   Data(Row, TotalCols + 1) = Temp
   Temp = Empty
   Next
   QuickSort Data, LBound(Data), UBound(Data)
   Sheets("Dich")..Resize(UBound(Data), TotalCols) = Data
   End Sub
   '**************************
   Sub QuickSort(Arr(), Min As Long, Max As Long)
   Dim MidVal As Variant, TempVal As Variant
   Dim TempMin&, TempMax&, LastCol&, TotalCol&
   TempMin = Min
   TempMax = Max
   LastCol = UBound(Arr, 2)
   MidVal = Arr((Min + Max) 2, LastCol)
   Do While TempMin <= TempMax
   Do While Arr(TempMin, LastCol) < MidVal And TempMin < Max
   TempMin = TempMin + 1
   Loop
   Do While MidVal < Arr(TempMax, LastCol) And TempMax > Min
   TempMax = TempMax – 1
   Loop
   If TempMin <= TempMax Then
   For TotalCol = 1 To LastCol
   TempVal = Arr(TempMin, TotalCol)
   Arr(TempMin, TotalCol) = Arr(TempMax, TotalCol)
   Arr(TempMax, TotalCol) = TempVal
   Next
   TempMin = TempMin + 1
   TempMax = TempMax – 1
   End If
   Loop
   If Min < TempMax Then QuickSort Arr, Min, TempMax
   If TempMin < Max Then QuickSort Arr, TempMin, Max
   End Sub

   dữ liệu Sheet nguon là sao Anh để Sort nó ra kết quả

   Đây là file test. Nói chung là thuật toán này không phải ai cũng có thể hiểu để edit đâu.

   Em mới thử dòng sau thay 1,2,3 chạy code thấy liền mà cột nó Sort
   SortOrder = Array(3, 3)

   Lâu lắm không tham gia bài nào, nay xin phép võ vẽ vài câu cùng mọi người nhé…
   Giải thích về Đệ quy…
   Lấy một ví dụ đơn giản thế này nhé:
   3 đại gia đình có 5 thế hệ xếp hàng ngang thành 5 hàng sao cho:
   Hàng 1 là tất cả những người thuộc thế hệ 1;
   Hàng 2 là tất cả những người thuộc thế hệ 2
   …
   Hàng 5 là tất cả những người thuộc thế hệ 5.

   Chọn một người (anh A) đứng vị trí 1 của hàng thứ 5, hãy xác định người đàn ông nào thuộc hàng 1 là cùng đại gia đình với người ở hàng thứ 5.
   Các bạn sẽ giải bài toán này bằng cách nào? Dùng biện pháp mô tả, không lập trình nhé.

   Khi giải được bài toán này là các bạn hiểu được đệ quy là gì?
   Trong thực tế thì Đệ quy là việc một chương trình gọi lại chính nó trong quá trình thực hiện (đệ quy đơn). Và có thể có phép đệ quy sử dụng nhiều chương trình con khác và chúng có thể gọi lẫn nhau (đệ quy tương hỗ) nhưng cách thực hiện là như nhau tùy theo tính phức tạp của bài toán.

   Bản chất của Đệ quy là giải pháp đơn giản hóa mối quan hệ nhiều tầng bằng cách xử lý từng cặp quan hệ có mối quan hệ gần nhau nhất, khi thỏa mãn điều kiện nào đó thì mới kết thúc còn chưa thỏa mãn thì tiếp tục xử lý cặp quan hệ ở mức độ tiếp theo.

   Ứng dụng Đệ quy là rất rộng lớn và tùy từng ngôn ngữ lập trình mà nó có giới hạn khác nhau.
   Quay lại bài toán trên, cách làm như sau:
   1. Hỏi ngưởi đứng đầu hàng 5 xem có quan hệ với anh bạn A không?
   + Nếu CÓ – Dừng, đổi anh A thành anh bạn mới này và quay lại 1 với người đầu ở hàng 4;
   + nếu KHÔNG, hỏi tiếp người thứ 2 cho đến khi gặp câu trả lời là có
   Sau nhiều vòng ta sẽ đến được người đứng hàng 1 – và nếu là CÓ thì kết thúc toàn bộ quá trình tìm kiếm

   Trong khoa học máy tính, mỗi lần chương trình gọi chính nó, một khu vực bộ nhớ mới sẽ được dành ra để chứa chương trình cho đến khi ra kết quả.
   Cái này người ta gọi đó là Stack và nếu không đến được kết quả cuối cùng, ta sẽ gây tràn bộ nhớ và làm cho toàn bộ hệ thống dừng hoạt động. Để tránh điều này, người ta đặt ra các giới hạn của số lượng Stack để tránh đổ vỡ cho hệ thống, khi đạt số lượng đó mà chương trình không ra kết quả thì trình quản lý ngôn ngữ lập trình sẽ dừng lại và báo lỗi.

   Vậy khi nào dùng đệ quy:
   + Khi bạn không dự đoán được độ sâu tìm kiếm (số hàng phả hệ trong bài toán trên)
   + Khi các mối quan hệ là tương đối đơn giản và bạn có thể đánh giá được hết các tình huống quan hệ

   Cấu trúc đệ quy bao gồm
   Phần khởi sự: Xử lý tham số đầu vào đơn giản nhất để dừng chương trình
   Phần đệ quy: Truyền tham số mới (tráo đổi vị trí) cho chính chương trình để nó tiếp tục xử lý

   Vậy với bài toán tìm tất cả các file Excel trong một thư mục sẽ được giải quyết thế này:

   A::Thủ tục gọi đệ quy: Truyền các tham số đầu vào như [Đường dẫn cần tìm]
   <Bắt đầu thủ tục A>
       [Danh sách File Excel] = B[Đường dẫn ban đầu]
   <Bắt đầu thủ tục A>
   
   B::Thủ tục đệ quy [Đường dẫn]
   <Bắt đầu hàm B>
   Biến C - Tên File
   + Vòng lặp Kiểm tra tất cả các đối tượng trong thư mục
   {
       + Nếu đối tượng hiện tại là 
       {
           + Thư mục: Gọi B [Đướng dẫn của thư mục này]
           + File:
               + Nếu là File Excel: Thêm tên File vào biến C
               + Còn ... Bỏ qua
       }
   }
   + Kết thúc vòng lặp trả về giá trị của Hàm B là giá trị C.
   <Kết thúc Hàm B::>

   Vậy đấy Đệ quy là như thế…
   Quay lại bài toán tìm File… các bạn có thể sử dụng chung 1 biến Fso Hệ thống được khởi tạo từ thủ tục A
   Bài toán sau đây của tôi là liệt kê tất cả các File Excel trong 1 thư mục cho trước

   Sub ListFiles()
       Dim fs As Object, FileStr As String, FileArr as Variant
   
   'Creating File System Object
       Set fs = CreateObject("Scripting.FileSystemObject")
   
   'Gọi thủ tục liệt kê các File trong 1 thư mục kể cả thư mục con
       FileStr = GetFiles(fs, "C:Windows", "|", "xls")
       Set fs = Nothing
       If Len(FileStr) > 1 Then
           FileStr = Mid(FileStr, Len(initSp) + 1)
           ' Loại bỏ những danh sách có 2 dấu ||
           FileStr = Replace(FileStr, "||", "|")
       End If
       ' Kết quả là danh sách File dưới dạng chuỗi và ta chuyển thành mảng để xử lý sau
       FileArr = Split(FileStr,"|")
   
   ' Các việc khác cần làm...
       ' In danh sách ra Sheet1
       Dim rng As Range
       Set rng = Sheet1.Cells(1)
       Set rng = rng.Resize(UBound(FileArr), 1)
       rng.Value = Application.Transpose(FileArr)
   End Function
   
   Private Function GetFiles(Fso As Object, FolderName As String, sp As String, flExt As String) As String
       On Error Resume Next
       Dim ObjFolder As Object
       Dim ObjSubFolders As Object
       Dim ObjSubFolder As Object
       Dim ObjFiles As Object
       Dim ObjFile As Object
       Dim OutString As String
   
   Set ObjFolder = Fso.GetFolder(FolderName)
       Set ObjFiles = ObjFolder.files
   
   'Ghi tất cả các File thỏa mãn vào biến nhớ OutString
       For Each ObjFile In ObjFiles
           If ObjFile.name <> "" Then
               If LCase(GetFileExtension(ObjFile.name)) Like LCase(flExt) Then
                   OutString = OutString & sp & ObjFile.path
               End If
           End If
       Next
       'Liệt kê tất cả các thư mục con
       Set ObjSubFolders = ObjFolder.SubFolders
   
   For Each ObjFolder In ObjSubFolders
           'Lấy tất cả các File trong thư mục con
           OutString = OutString & sp & GetFiles(Fso, ObjFolder.path, sp, flExt)
       Next
       ' Trả về kết quả
       GetFiles = OutString
   End Function
   
   Function GetFileExtension(FileName As String) As String
       ' Trả về phần đuôi của file
       On Error Resume Next
       GetFileExtension = Mid(FileName, InStrRev(FileName, ".") + 1)
   End Function

   LƯU Ý: Tuy nhiên, thường thì nên tránh lạm dụng đệ quy vì nó sẽ gây lỗi nếu ta không dự tính được hết các tình huống phát sinh. Cái gì có thể giải quyết theo cách thường thì cứ thế mà làm.
   Tôi không hay dùng đệ quy trong các bài toán của mình song có những lúc cũng cần. Ví dụ:
   + Liệt kê các File trong thư mục
   + Duyệt qua các đối tượng trong 1 TreeView (Cây)
   + Xử lý công thức như trong Excel …

   Và… Trong thiết kế đệ quy::
   + Phải nắm được mối quan hệ giữa các đối tượng xử lý;
   + Giải quyết được tất cả các tình huống phát sinh khi đánh giá một cặp quan hệ

   Mình đọc tới lui cũng chưa hiểu chạy Sub ListFiles sẽ lấy kết quả ra hình thù gì …??hay gán lên Sheet như thế nào Bạn … có thể chỉ thêm cho mình được không
   xin cảm ơn

   Bạn xem đoạn này

   ' Các việc khác cần làm...
       ' In danh sách ra Sheet1
       Dim rng As Range
       Set rng = Sheet1.Cells(1)
       Set rng = rng.Resize(UBound(FileArr), 1)
       rng.Value = Application.Transpose(FileArr)

   Nó in ra sheet1 danh sách file… Tôi làm ví dụ để các bạn hiểu về Đệ quy thôi
   (nhớ thay đổi tham số đường dẫn ban đầu nhé)

   Vậy code ở bài #1 Mình viết như vậy có phải là đệ quy không Bạn …?!

   Mình không Rành lắm thấy ai đó viết bắt trước viết vậy thôi chứ….còn hiểu thì hông biết

   Đó chính là đệ quy – "Một hàm/ Thủ tục gọi lại chính nó" trong tiến trình thực hiện.
   Không nên quá lo sợ về đệ quy nhé! Nó đơn giản thôi, không quá phức tạp nếu bạn hiểu rõ các mối quan hệ trong bài toán lớn.
   (Hãy đọc cách phân tích bài toán phả hệ mà tôi viết, nếu không thì có thể nghiên cứu về thuật giải Giai thừa nữa…)
   Thân

   Thế mà có ai đó keo nếu đã sử dụng đệ quy thì sẽ không có vòng lặp làm gì và đó không phải là đệ quy đúng nghĩa …Mình cứ nghĩ Mình theo cái môn phái tà đạo nào chăng…

   Và cách sử dụng If InSub Then Bạn thấy thế nào ….

   Xin cảm ơn

   Function Giaithua(n As Long) As Long
     If (n = 1) Then
       Giaithua = 1
       Exit Function
     End If
     Giaithua = n * Giaithua(n - 1)
   End Function

   bản chất của đệ quy là thay thế vòng lập đó anh.

   Kiêu Mạnh còn rất thanh niên đấy nhá (có thể già lão nhưng tính cách thanh niên như tớ) … quan trọng là mình giải thích được cách làm của mình. Kiến thức là trừu tượng, khái niệm cũng như vậy. Bạn có thể tự định nghĩa một khái niệm cho riêng mình, đâu cần cứ nhất thiết phải có ai đó cùng đưa ra quan điểm về nhận định đó của bạn.
   Cộng đồng là nơi chia sẻ và cũng là nơi những ý kiến nhỏ trở thành phát kiến lớn….
   (Bài toán Tháp Hà nội là một ví dụ kinh điển theo kiểu đó)
   Chúc các bạn vui vẻ!

   Đọc thêm về Đệ quy
   https://www.cs.utah.edu/~germain/PPS/Topics/recursion.html
   en.wikipedia.org/wiki/Recursion_(computer_science)
   https://www.cs.odu.edu/~cs381/cs381content/recursive_alg/rec_alg.html

   Định nghĩa tạm gọi là thông dụng của Đệ quy trong Thuật toán và khoa học máy tính thế này:
   Thuật toán:
   Thuật toán đệ quy là thuật toán tự gọi chính nó với giá trị đầu vào "nhỏ hơn hoặc đơn giản hơn" theo đó trả về kết quả tính toán của giá trị đầu vào bằng cách thức đơn giản đối với giá trị trả về của giá trị đầu vào nhở hơn đó. Nói chung, nếu một vấn đề có thể giải quyết bằng cách áp dụng cùng phương pháp đối với các giá trị đầu vào nhỏ hơn theo đó việc giảm dần tính phức tạp của giá trị đầu vào sẽ giải quyết được bài toán thì người ta gọi đó là Đệ quy.

   Nói khác hơn Đệ quy trong lập trình là việc MỘT THỦ TỤC/HÀM GỌI LẠI CHÍNH NÓ để thực hiện việc gì đó.
   Việc sử dụng lặp hay không lặp đó chỉ là tiểu tiết các bước xử lý trong chương trình mà không phải là biện pháp của ĐỆ QUY.

   Và hiện đang có hàng ngàn cách định nghĩa khác nhau đối với đệ quy.

   Em mới thử dòng sau thay 1,2,3 chạy code thấy liền mà cột nó Sort
   SortOrder = Array(3, 3)

   Bạn hiền:
   ———
   Mới xem file #37 của anh QuangHai rất chi là hay:

   Tham số trong mảng: SortOrder = Array(2 3) của anh ấy là sort theo 2 cột, ưu cột 2, rồi đến cột 3

   Nếu đổi ngược lại SortOrder = Array(3, 2): thì nó ưu tiên sort cột 3 trước, và sort lại cột 2 theo cột 3…

   Và nếu thêm tham số vào tiếp trong mảng trên: SortOrder = Array(3, 2,1,6,5,…) thì nó cứ ưu tiên cái đầu tiên,…và kế tiếp, sort kế tiếp…

   => Code này của anh Quang Hải ứng dụng rất tốt trong việc Sort nhiều cột trên mảng Ảo…: Ôi thần linh ơi…

   Và chú ý hơn là: trên mảng ảo… anh ấy thêm 1 cột cuối cùng, nối mảng vào đây. Và sort cột này…hic hic….-\/.-\/.-\/.

   Đệ quy là phương pháp rất hay, nhưng khá "khó xơi". Thấy các bạn gợi ý về hàm API, mình xin góp vui ít code dùng API (không đệ quy)^^.

   Option Explicit
   
   Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
   Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileW" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
   Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
   
   Const MAX_PATH = 255
   Const FILE_ATTRIBUTE_DIRECTORY = &H10
   Const FILE_ATTRIBUTE_HIDDEN = &H2
   Const FILE_ATTRIBUTE_NORMAL = &H80
   Const FILE_ATTRIBUTE_READONLY = &H1
   Const FILE_ATTRIBUTE_SYSTEM = &H4
   
   Private Type FILETIME
       dwLowDateTime As Long
       dwHighDateTime As Long
   End Type
   
   Private Type WIN32_FIND_DATA
       dwFileAttributes As Long
       ftCreationTime As FILETIME
       ftLastAccessTime As FILETIME
       ftLastWriteTime As FILETIME
       nFileSizeHigh As Long
       nFileSizeLow As Long
       dwReserved0 As Long
       dwReserved1 As Long
       cFileName As String * MAX_PATH
       cAlternate As String * 14
   End Type
   
   Private Sub CheckDir(sFolder As String, DirCount As Integer, fileCount As Integer)
       Dim myFolder As New Collection
       Dim FileData As WIN32_FIND_DATA
       Dim res As Long, hFind  As Long, fileName As String
       Dim Sh As Worksheet, Arr(), Target As Worksheet
       Set Target = Sheets("TongHop")
       DirCount = 0
       fileCount = 0
       myFolder.Add (sFolder)
   
   Do While (myFolder.Count)
   
   sFolder = myFolder.Item(1)
       myFolder.Remove (1)
   
   hFind = FindFirstFile(StrConv(sFolder & "*.*", vbUnicode), FileData)
       If (hFind = -1) Then GoTo finish
   
   Do
       fileName = StripNulls(FileData.cFileName)
       If (fileName <> ".") And (fileName <> "..") Then
       If (FileData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
       myFolder.Add (sFolder & "" & fileName)
       DirCount = DirCount + 1
       Else
       fileCount = fileCount + 1
   
   If Not (fileName Like "*TongHop.xlsb") Then
       With Workbooks.Open(sFolder & "" & fileName)
       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
   
   res = FindNextFile(hFind, FileData)
       Loop Until (res = 0)
   
   finish:
       FindClose (hFind)
       Loop
   End Sub
   
   Function StripNulls(OriginalStr As String) As String
       OriginalStr = StrConv(OriginalStr, vbFromUnicode)
       If (InStr(OriginalStr, Chr(0)) > 0) Then
       OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
       End If
       StripNulls = OriginalStr
   End Function
   
   Private Sub Test()
       Dim DirCount As Integer, fileCount As Integer
       Dim Path As String
       ActiveSheet.UsedRange.ClearContents
       Path = ThisWorkbook.Path
       CheckDir Path, DirCount, fileCount
       MsgBox "Check Complete - Folder: " & DirCount & " - File: " & fileCount
   End Sub

   Bạn Hiền Thử code sau xem sao

   Sub ArraySort()
   'Written by QuangHai
   Dim Data()
   Data = Array(20, 19, 18, 17, 16, 8, 14, 13, 12, 11, 10, 9)
   QuickSort Data, LBound(Data), UBound(Data)
   MsgBox Join(Data)
   End Sub

   Bạn test chưa? code này sao chạy được bạn…Xem lại mảng Data nha…–=0–=0–=0

   Hình lỗi như sau………..Mình cũng không biết nữa
   Mới tìm ra xong Phải Thêm

   Path = ThisWorkbook.Path [B]& ""

   …Như vậy nó lấy được cái Folder thứ nhất …xong Folder trong Nó nữa là lỗi…Lỗi này nhỏ thôi mà

   Thêm dòng sau nữa trong CheckDir là OK tuyệt đối…Cảm ơn Bạn

   If Right(sFolder, 1) <> "" Then sFolder = sFolder + ""

   Thuật toán đệ quy không phải dễ ăn đâu. Dám cá trong 10 cao thủ trên diễn đàn thì hết 9 người không viết vẽ gì được nếu giao cho 1 máy tính mới tinh và buộc phải viết mọi thứ từ trong đầu lâu. Mình cũng đã từng nghiên cứu mất cả tuần, nhưng giờ nếu ngồi viết từ đầu mà không nhìn lại code cũ thì pó tay.

   Có lẽ ta nên thảo luận vui một chút về phản hồi của bác Hải để mọi người thêm tự tin khi làm việc với Đệ quy! Mạn phép bác nếu có gì lỗ mỗ nhé. Em toàn là thiện ý thôi
   
   1. Code cũ và code mới.… Đúng 99%
   Nhiều khi các ý tưởng chỉ lóe sáng trong chốc lát sau đó không bao giờ có lại được vì thế việc tham khảo code cũ là điều đương nhiên. Em tin rằng không ai trong chúng ta mà không phải tham khảo các nguồn mã có sẵn để biên lại.
   (Nếu không làm thế thì làm sao có cộng đồng mạng và GPL – mã nguồn mở)
   Thêm nữa, với việc sử dụng các đoạn mã có sẵn ta tiết kiệm được rất nhiều thời gian thay vì lại phải nghĩ lại từ những bài toán cũ.
   Tuy nhiên, việc bác đưa ra tình huống máy mới … thì có lẽ cũng hơi không liên quan mấy về vấn đề thảo luận về ĐỆ QUY HÀM

   2. Đệ quy khó …. chưa hợp lý lắm
   Đệ quy không khó về quan điểm lý thuyết, nếu ta cho rằng nó khó bởi vì ta chưa tiếp cận nó một cách phù hợp và kín kẽ mà thôi.
   Đối với nhiều người, việc tự dưng hàm này lại tự gọi nó thì ngay cả trong tưởng tượng cũng khó mà theo được – vì thế nó khó.

   Lấy ví dụ về tính giai thừa
   n! = 1 x 2 x …. x n
   Ta sẽ thấy ngay cách giải tuần tự là đơn giản nhất

   Function Giaithua(n as long) as double
       Dim i as Long, Ketqua as Double
       For i=1 to n
           Ketqua = Ketqua * i
       Next
       Giaithua = Ketqua
   End Function

   Còn ứng dụng đệ quy thế nào?
   Hãy phân tích vấn đề 1 chút
   Với phép toán tính n!
   + Chỉ dừng thực hiện phép nhân khi thừa số nhỏ hơn n hoặc (nếu bất đầu thực hiện phép nhân từ 1);
   + Chỉ dừng thực hiện phép nhân khi thừa số lớn hơn 1 (nếu bắt đầu nhân từ n)
   Vậy cái phép toán giống nhau đó là nhân và tham số sẽ giảm dần hoặc tăng dần.

   Thế thì có thể áp dụng Đệ quy để tính giai thừa như thế này:
   Cách 1 – Giảm dần

   Function GiaithuaNguoc(n As Long) As Double
       If n = 1 Then
           GiaithuaNguoc = 1
       Else
           GiaithuaNguoc = n * GiaithuaNguoc(n - 1)
       End If
   End Function

   Theo cách này, phương pháp sẽ thực hiện như sau:
   Khi n khác 1 thì
   Giá trị giai thừa = n x kết quả của phép giai thừa với n giảm đi 1 đơn vị.
   Việc tính này sẽ tích lũy cho đến khi n = 1 thì dừng lại và kết thúc phép nhân

   Cách 2 – tăng dần

   Function GiaithuaThuan(n As Long, Optional i As Long = 1) As Double
       If i < n Then
           GiaithuaThuan = i * GiaithuaThuan(n, i + 1)
       Else
           GiaithuaThuan = n
       End If
   End Function

   Theo cách này thì, khi biến thực hiện nhỏ hơn n
   Giá trị giai thừa = biến đó x kết quả phép giai thừa với thừa số có giá trị tăng 1 đơn vị.
   Việc tính này sẽ kết thúc khi biến đếm dừng lại ở giá trị n.

   Muốn làm được với thuật toán đệ quy thì ta cần nắm vững quá trình tính toán theo cách của máy tính và biết được cái gì sẽ giả về và cái gì sẽ là tham số.
   Như vậy em nghĩ nó sẽ đơn giản hơn rất nhiều.

   Túm lại em chỉ muốn chia sẻ một cách nhìn khoan dung với Đệ quy… rất mong các bác chia sẻ thêm vài luận điểm nữa để các bạn trẻ có thể hiểu rõ và làm chủ được Đệ quy.

   Và để bổ sung cho việc đơn giản hóa Đệ quy, các bạn hãy xem Video sau đây với kỹ năng dùng debug nhé. Với cách làm này mọi người sẽ hiểu hơn về đệ quy
   zBsad01ZyG8
   Hùa theo bài viết trên, tôi xin tặng các bạn 2 công cụ (đơn giản, thừa kế, sử dụng mã nguồn của nhiều bên và cả của tôi) để làm việc:
   + Cho phép dịch văn bản trên Word bằng công cụ Google Translate [URL='https://thuthuataccess.com/forum/thread-9138-post-30400.html#pid30400'%5D(đọc bài chi tiết ở đây). Chọn văn bản, nhấn Ctrl+Shift+E dịch Anh Việt và Ctrl+Shift+V để làm ngược lại
   + Cho phép dịch văn bản trên Excel [URL='https://thuthuataccess.com/forum/thread-9138-post-30062.html#pid30062'%5D(đọc bài chi tiết ở đây). Chọn vùng, nhấn Ctrl+Shift+E dịch Anh Việt và Ctrl+Shift+V để làm ngược lại
   Sự đặc biệt của công cụ này đó là việc ứng dụng công nghệ truy vấn Web không đồng bộ (Asynchronous) với WinHttp/XmlHttp.
   Nếu các bạn (doveandrose chẳng hạn) sử dụng Winhttp trong VBA thường phải để chế độ Asynchronous là False để đợi bao giờ máy chủ Web trả lời xong mới làm việc tiếp. Với 2 công cụ này, chúng ta đặt là True và bạn có thể thấy việc dịch được tiến hành đồng thời với nhiều Cell hoặc đoạn văn cùng lúc.
   Template cho Word: https://www.sfdp.net/thuthuataccess/Normal.dotm?attredirects=0&d=1
   Addin cho Excel: https://www.sfdp.net/thuthuataccess/Tools.xlam?attredirects=0&d=1

   PS.. Xin lỗi Ban quản trị vì tôi trích dẫn bài ở trang web khác (vì ngại viết lại hoặc cắt dán, copy). Đa tạ!
   Ngoài ra, xin bổ sung thêm một ứng dụng nhỏ viết bằng Access để truy cập Google Drive, tải file lên mà không cần tới InternetExplorer hoặc trình duyệt.
   (Cũng là cóp nhặt, sáng kiến …vv). Toàn văn các bài viết [URL='https://thuthuataccess.com/forum/thread-8708.html'%5Dở đây.

   Ứng dụng ở đây: https://www.sfdp.net/thuthuataccess/demo/democAuth.rar?attredirects=0&d=1

   Reply
3. hands says:

   17/01/2023 at 9:17 am

   Mạnh chưa Hiểu Hàm sau lắm … Nếu xài hàm sau thì có thay thế được 3 Hàm trên của Bạn hay không… ý mình muốn đơn gian hóa thêm một tí về API đó mà…

   Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
   Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesW" (ByVal lpFileName As String) As Long

   Ý nghĩa của hàm:
   "If the function succeeds, the return value contains the attributes of the specified file or directory. "
   Do vậy nếu bạn muốn sử dụng thì nó chỉ thay thế cho phần:

   If [COLOR=#ff0000](FileData.dwFileAttributes[/COLOR] And FILE_ATTRIBUTE_DIRECTORY) Then

   trong việc xác định attribute tương ứng (ở đây nhằm xác định nó là 1 thư mục, trước đó đã loại trừ 2 dạng thư mục hiện tại (.) và thư mục cha (..)):

   Const FILE_ATTRIBUTE_DIRECTORY = &H10
   Const FILE_ATTRIBUTE_HIDDEN = &H2
   Const FILE_ATTRIBUTE_NORMAL = &H80
   Const FILE_ATTRIBUTE_READONLY = &H1
   Const FILE_ATTRIBUTE_SYSTEM = &H4

   nếu vậy Ta sử dụng FileSystemObject kết kết hợp với nó duyệt Folder
   đương nhiên nếu sử dung Fso thì sẻ chơi được với File và Folder là tiếng Việt có dấu…
   Nếu vậy thì code cực ngắn…Code này Mình (ST)

   Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
   Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesW" _
                           (ByVal lpFileName As String) As Long
   
   Function FileAttributes(ByVal sFolders As String) As Boolean
   FileAttributes = (GetFileAttributes(sFolders) And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY
   End Function

   Mình chưa hiểu ý bạn lắm, vì FSO đã có phần subfolder, và lưu ý rằng đây là việc tìm file và thư mục theo chiều rộng (nôm na là duyệt lần lượt, từng file một, nếu gặp thư mục thì ghi chú lại để viếng thăm lần tiếp theo) và như thế có thể sẽ không phải là tư duy của đệ quy (theo chiều sâu, duyệt hết "tận ngọn" các thư mục sau đó làm gì thì làm).

   Mình thử phát triển code đệ quy dựa trên code mình đã up lên như sau:

   'Khai bao
   Option Explicit
   
   Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
   Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileW" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
   Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
   
   Const MAX_PATH = 255
   Const FILE_ATTRIBUTE_DIRECTORY = &H10
   Const FILE_ATTRIBUTE_HIDDEN = &H2
   Const FILE_ATTRIBUTE_NORMAL = &H80
   Const FILE_ATTRIBUTE_READONLY = &H1
   Const FILE_ATTRIBUTE_SYSTEM = &H4
   
   Private Type FILETIME
       dwLowDateTime As Long
       dwHighDateTime As Long
   End Type
   
   Private Type WIN32_FIND_DATA
       dwFileAttributes As Long
       ftCreationTime As FILETIME
       ftLastAccessTime As FILETIME
       ftLastWriteTime As FILETIME
       nFileSizeHigh As Long
       nFileSizeLow As Long
       dwReserved0 As Long
       dwReserved1 As Long
       cFileName As String * MAX_PATH
       cAlternate As String * 14
   End Type
   
   'Ham de quy
   Private Sub Dequy(sFolder As String)
       Dim FileData As WIN32_FIND_DATA
       Dim hFind  As Long, fileName As String, tmpFolder As String
       Dim Sh As Worksheet, Arr(), Target As Worksheet
       Dim res As Long
       Set Target = Sheets("TongHop")
   
   tmpFolder = sFolder
       hFind = FindFirstFile(StrConv(tmpFolder & "*.*", vbUnicode), FileData)
       If (hFind = -1) Then GoTo finish
   
   Do
   
   fileName = StripNulls(FileData.cFileName)
       If (fileName <> ".") And (fileName <> "..") Then
       If (FileData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
   
   Dequy tmpFolder & "" & fileName
   
   Else
   
   MsgBox fileName
       If Not (fileName Like "*TongHop.xlsb") Then
       With Workbooks.Open(tmpFolder & "" & fileName)
       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
   
   res = FindNextFile(hFind, FileData)
       Loop Until (res = 0)
   
   finish:
       FindClose (hFind)
   
   End Sub
   
   'Ham bo tro
   Function StripNulls(OriginalStr As String) As String
       OriginalStr = StrConv(OriginalStr, vbFromUnicode)
       If (InStr(OriginalStr, Chr(0)) > 0) Then
       OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
       End If
       StripNulls = OriginalStr
   End Function
   
   'Test thu
   Private Sub Test2()
       Dim Path As String
       ActiveSheet.UsedRange.ClearContents
       Path = ThisWorkbook.Path
       Dequy Path
       MsgBox "Check Complete "
   End Sub

   Mình đã hiểu tại sao bị lỗi, là do trong code có phần sFolder & "" & fileName
   tuy nhiên khi up lên diễn đàn thì dấu "" không hiện.
   (Mình phản đánh "\" thì diễn đàn mới hiện "").

   Thôi đau đầu quá ta chuyển qua ADO xem tình hình sao

   Mình thử một cách đệ quy theo Fso xem sao:

   Option Explicit
   
   Private Sub Dequy(sFolder As String)
   Dim objsFolder As Object
   For Each objsFolder In CreateObject("Scripting.FileSystemObject").GetFolder(sFolder).subFolders
   Dequy objsFolder.Path
   Next
   Getfile sFolder
   End Sub
   
   Private Sub Getfile(FolderName As String)
   Dim ObjFiles As Object, ObjFile As Object
   Dim Sh As Worksheet, Arr(), Target As Worksheet
   Set Target = Sheets("TongHop")
   Set ObjFiles = CreateObject("Scripting.FileSystemObject").GetFolder(FolderName).Files
   
   For Each ObjFile In ObjFiles
       If Not (ObjFile.Name Like "*TongHop.xlsb") 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
   Next
   
   End Sub
   
   Sub test()
   ActiveSheet.UsedRange.ClearContents
   Dequy ThisWorkbook.Path
   End Sub

   Thích tách ra 3 khúc ta cũng chơi 3 khúc xem tình hình sao

   Public Sub GetFolderFiles(sFolder As String, 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
                       TongHopFiles ObjFile
                   End If
               End If
           End If
       Next ObjFile
       If inSub Then
           For Each objsFolder In .GetFolder(sFolder).subFolders
               Call GetFolderFiles(objsFolder.Path, True)
           Next objsFolder
       End If
   End With
   End Sub
   
   Public Sub TongHopFiles(ByVal sFile As String)
       Dim Sh As Worksheet, Arr(), Target As Worksheet
       Set Target = Sheets("TongHop")
       With Workbooks.Open(sFile)
           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 Sub
   
   Sub XYZ()
       Dim Path As String
       Path = ThisWorkbook.Path
       ActiveSheet.UsedRange.ClearContents
       GetFolderFiles Path, True
   End Sub

   Reply
4. hands says:

   17/01/2023 at 9:18 am

   Mình thử một cách đệ quy theo Fso xem sao:
   …
   CreateObject("Scripting.FileSystemObject")
   …

   Trong đệ quy thì nên tránh việc khởi tạo liên tục đối tượng FileSystemObject như thế này vì sẽ làm tăng tải lên hệ thống và bộ nhớ bên cạnh việc khó kiếm soát các lỗi phát sinh.
   Các bạn nên dùng chung 1 biến khởi tạo từ thủ tục gọi ban đầu…
   Dạng thế này

   Sub Thuchien()
       Dim Fso as Object
       set Fso=CreateObject("Scripting.FileSystemObject")
       ThutucDequy(Fso,"đường dẫn")
   End Sub
   Private Sub ThutucDequy(Fs as Object, Duongdan as string)
       ...
           ThutucDequy Fs, Duongdanmoi
       ...
   End Sub

   Ngoài ra, để tiện cho việc gỡ lỗi, nên khai thác đệ quy theo cách sau:
   1. Thủ tục chính
   ::…
   Biến kết quả Đệ quy = Hàm Đệ quy
   ::..
   2. Sử dụng kết quả đệ quy để thực hiện các việc khác.

   Nói khác hơn, tách biệt việc tính toán, xử lý đệ quy ra khỏi các xử lý ít liên quan rồi sau đó dùng xử lý tuần tự để thao tác với kết quả.
   Chẳng hạn, với bài toán mở tất cả các file trong 1 thư mục thì nên làm như sau:
   1. Tạo thủ tục chính
   Gọi thủ tục đệ quy lấy danh sách file

   2. Xử lý kết quả
   Như thế vừa dễ kiểm soát lỗi vừa đảm bảo ứng dụng chạy có tốc độ tốt hơn.

   Reply
5. hands says:

   17/01/2023 at 9:20 am

   Nhá Code cho Bạn nào thích thì Thử chơi…Mạnh làm luôn 2 câu của bài #27

   Lưu ý:

   1/ Nếu máy mà từ Win7 trở lên mà UAC đang ON thì Chạy File *.bat hay Register DLL.exe thì Phải chọn Run As …

   2/ Bạn nào thích đăng ký bằng Fille *.bat thì đăng ký … Nếu không Thích thì chạy File Register DLL.exe chọn Yes nó sẽ giải nén File ADODeQuy.dll

   vào C:WindowsSystem32ADODeQuy.dll

   Xong chép toàn bộ code sau vào một module và chạy code Test thử….

   Nếu ai thích thì vẫn sử dụng File thư viện đó cho công việc của mình Vô tư tùy thích

   Mời các Bạn test chơi ADO Tổng Hợp dữ liệu các Files theo thuật Toán Đệ Quy

   Xin cảm ơn

   Public ADO As Object
   Public DataRange As String, Path As String
   
   Public Sub SetExcelConnection()
       Set ADO = CreateObject("ADODeQuy.DeQuy")
       Set ADO.ExcelApp = Application
   End Sub
   
   Tổng hợp tất cả các Sheet THU trong tất cả các File từ Folder từ Cha => Cháu ...
   
   Public Sub TongHop_SheetTHU()
       Call SetExcelConnection
       DataRange = "THU$A6:J1000"
       Path = ThisWorkbook.Path
       ActiveSheet.UsedRange.ClearContents
       ADO.GetListFilesInSub Path, DataRange, [A65536], True
       Set ADO = Nothing
   End Sub
   
   Tổng hợp tất cả các file và tất cả các Sheet trong File có từ Folder cha cho đến folder con cháu...
   
   Public Sub TongHop_FilesSheetsALL()
       Call SetExcelConnection
       Path = ThisWorkbook.Path
       DataRange = "A6:J100"
       ActiveSheet.UsedRange.ClearContents
       ADO.GetListFileSheets Path, DataRange, [A65536], True
       Set ADO = Nothing
   End Sub

   Code chính của kieu manh thì nằm trong dll rồi, vậy giải pháp về thuật toán biết xem ở đâu đây ta?
   Đề nghị bác Kiều Mạnh phải…đem code vào File Excel & Púp Bờ Líc…mới đúng tinh thần chia sẽ nha (ở trên toàn là tinh thần chia sẽ mà…sao phải nhét vào kẹt thế kia???)
   Ai chơi cứ nhét vào dll…–=0–=0–=0

   Thì bài #82 có nói rõ mục đích rồi đó Bồ …từ từ thư thả vội …. xem tình hình sao …hạ hồi ta sẻ úp –=0–=0–=0

   Bạn thử viết 1 cái coi … xem tình hình sao…

   Việc lấy dữ liệu file Excel bằng ADO có một số hạn chế có thể dẫn đến kết quả sai. Tôi ngại thử code mà tôi không biết nội dung nên bạn tự mình thử xem code của bạn có lấy đúng nội dung của file này không.

   Reply