Vui Chơi Với Thuật Toán Đệ Quy Trong Lập Trình Với Excel (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Kiều Mạnh

I don't program, I beat code into submission!!!
Tham gia
9/6/12
Bài viết
5,538
Được thích
4,133
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

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
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.
 
Upvote 0
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
 
Upvote 0
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ị

Mã:
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

Mã:
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
 
Upvote 0
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
 
Upvote 0
Upvote 0
Mấy năm trước mình cũng thử mò cái đệ quy này cơ mà khó nhằn nên "té" +-+-+-++-+-+-+

Bạn có thời gian thì "ngó" 1 chút topic sau, code đã được bạn "Tự động trả lời" sửa lại ngắn gọn súc tích hơn.

Cảm ơn bạn đã có những chia sẻ về món này nhé!

http://www.giaiphapexcel.com/forum/...-paste-hàng-loạt-tên-file&p=710663#post710663
Thì mình cũng đang trên bước đường nghiên cứu thôi ...ngồi không buồn buồn bày trò ra để chơi vậy chứ ...và cũng mong muốn hoc hỏi thêm ở nhiều góc độ khác trong cách xử lý của một vấn đề đó mà....

Triết học 1 tí:

1/ Trong cùng một sự vật hiện tượng ....ta muốn nghiên cứu hay phán xét nó ...

Thì phải xem xét nó trong vận động ở nhiều góc độ khác nhau....thì mới có thể đưa ra được kết luận khá chính xác...

2/ Code két cũng vậy nhiều khi mình viết trên máy mình thấy OK rồi đó ...cứ nghĩ vậy là ngon ...nhưng khi úp bài lên cho người khác sử dụng thì nó mới lòi ra nhiều vấn đề cần xem xét ....và bất chợt nhìn thấy chính khả năng của mình nó bé tẹo như cái kẹo....

Vậy Mạnh lập ra thớt này là vì vậy đó....
 
Lần chỉnh sửa cuối:
Upvote 0
2/ Code két cũng vậy nhiều khi mình viết trên máy mình thấy OK rồi đó ...cứ nghĩ vậy là ngon ...nhưng khi úp bài lên cho người khác sử dụng thì nó mới lòi ra nhiều vấn đề cần xem xét ....và bất chợt nhìn thấy chính khả năng của mình nó bé tẹo như cái kẹo....
Tôi thích câu nói này, thật ra đã xem các bài trong topic này nhưng trình độ của mình về đệ quy thì rất tệ, nên chủ yếu là xem các cao thủ trổ tài thôi. Những bài viết đáng học hỏi, một lần nửa cảm ơn chủ topic.
 
Upvote 0
Mấy năm trước mình cũng thử mò cái đệ quy này cơ mà khó nhằn nên "té" +-+-+-++-+-+-+

Bạn có thời gian thì "ngó" 1 chút topic sau, code đã được bạn "Tự động trả lời" sửa lại ngắn gọn súc tích hơn.

Cảm ơn bạn đã có những chia sẻ về món này nhé!

http://www.giaiphapexcel.com/forum/...-paste-hàng-loạt-tên-file&p=710663#post710663

mình để ý thấy hình như bạn "tự động trả lời" là fan hâm mộ của anh hpkhuong thì phải
bằng chứng là bạn "tự động trả lời" học tập sử dụng từ khóa static của anh hpkhuong ở bài #17
và đây cũng là câu trả lời cho nghi ngại của bạn Hau151978

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
Bằng chứng là anh hpkhuong học được từ anh "tự động trả lời" cái vụ rút gọn đó đó...haha....--=0--=0--=0
---------------------
Vì lang thang hôm bữa bữa...gặp bài của anh í rút gọn rất chi là hay nên ứng dụng đó mà lị...@$@!^%
Mạnh chưa hiểu sâu cái static lắm ....hai bạn dro và hpk chỉ cho cái đi ....%#^#$
 
Upvote 0
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ừ.

PHP:
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", .[M65536].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").[A3].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
 
Upvote 0
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ừ.

PHP:
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", .[M65536].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").[A3].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ả
 
Upvote 0
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:


[GPECODE=vb]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::>[/GPECODE]


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


[GPECODE=vb]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[/GPECODE]


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ệ
 
Lần chỉnh sửa cuối:
Upvote 0
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:


Mã:
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


Mã:
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...
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
 
Upvote 0
Bạn xem đoạn này
[GPECODE=vb]' 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)[/GPECODE]
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é)
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn xem đoạn này
[GPECODE=vb]' 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)[/GPECODE]
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
 
Lần chỉnh sửa cuối:
Upvote 0
Đó 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
 
Upvote 0
Đó 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
 
Upvote 0
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
Mã:
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.
 
Upvote 0
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
http://www.cs.utah.edu/~germain/PPS/Topics/recursion.html
https://en.wikipedia.org/wiki/Recursion_(computer_science)
http://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.
 
Lần chỉnh sửa cuối:
Upvote 0
Kiêu manh còn rất thanh niên đấy nhá... 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ẻ!
OK ...Mạnh hiểu ý Bạn mà....Câu trả lời Rất hay....Lách một cách tài tình...

Kiều Mạnh là một Lão nông thuần túy mà ....Còn đâu nữa mà thanh niên chứ ...,,,,,,,{}{}{

Cảm ơn Bạn
 
Upvote 0
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....-\\/.-\\/.-\\/.
nếu bạn muốn quan tâm về các kỹ thuật sort, thì tìm hiểu mười mấy cách sort trong kỹ thuật lập trình, cách của anh hải là 1 trong mười mấy cách đó, thường làm việc với excel nó có sẳn hết nên những cách sort này bị lãng quên theo thời gian
ở đây có bàn về một số sort những đã bị lãng quên
http://www.giaiphapexcel.com/forum/showthread.php?98887-Một-số-thuật-toán-về-sort-mảng
 
Lần chỉnh sửa cuối:
Upvote 0
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....-\\/.-\\/.-\\/.
Bạn Hiền của Mạnh ơi ....Code đó Anh Hải Copy cho Mạnh lâu lắm rồi ...Code đó thần linh mà
 
Upvote 0
OK ...Mạnh hiểu ý Bạn mà....Câu trả lời Rất hay....Lách một cách tài tình...

Kiều Mạnh là một Lão nông thuần túy mà ....Còn đâu nữa mà thanh niên chứ ...,,,,,,,{}{}{

Cảm ơn Bạn

anh Paulsteigel chắc thuộc thế hệ chú bác của mình , nên anh ấy dùng chữ "còn thanh niên quá"
chứ như mình là phang ngay câu : "còn trẻ trâu quá" . ha hahahahahaha
Đối với mình thì ai thích nói câu gì cũng được . Nhưng phải chứng minh được mình nói đúng bằng hành động cụ thể .
Chẳng hạn như
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

mình vẫn chưa nhìn thấy bài viết nào viết lại #1 mà bỏ hết các vòng lặp . Nên mình không tin tưởng , thông cảm mình chỉ tin vào cái gì mình thấy cụ thể , đó là lời thật lòng chứ không chỉ trích ai hết .
 
Upvote 0
anh Paulsteigel chắc thuộc thế hệ chú bác của mình , nên anh ấy dùng chữ "còn thanh niên quá"
chứ như mình là phang ngay câu : "còn trẻ trâu quá" . ha hahahahahaha
Đối với mình thì ai thích nói câu gì cũng được . Nhưng phải chứng minh được mình nói đúng bằng hành động cụ thể .
Chẳng hạn như


mình vẫn chưa nhìn thấy bài viết nào viết lại #1 mà bỏ hết các vòng lặp . Nên mình không tin tưởng , thông cảm mình chỉ tin vào cái gì mình thấy cụ thể , đó là lời thật lòng chứ không chỉ trích ai hết .
mình thì khác nha, ai nói gì làm gì cũng ok, thích thì làm không thì thôi, cũng chẳng cần ai đánh giá này nọ, chỉ cần xếp đánh giá và trả lương là ok rồi, còn trên diễn đàn học hỏi trao đổi vui chơi là chính, nên cũng chẳng chứng tỏ hơn thua làm gì? ai cũng có thể hơn mình mà đúng không?
 
Upvote 0
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
Đệ 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)^^.
[GPEcode=vb]
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


[/GPEcode]
 
Lần chỉnh sửa cuối:
Upvote 0
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....-\\/.-\\/.-\\/.
Bạn Hiền Thử code sau xem sao
Mã:
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
 
Upvote 0
mình thì khác nha, ai nói gì làm gì cũng ok, thích thì làm không thì thôi, cũng chẳng cần ai đánh giá này nọ, chỉ cần xếp đánh giá và trả lương là ok rồi, còn trên diễn đàn học hỏi trao đổi vui chơi là chính, nên cũng chẳng chứng tỏ hơn thua làm gì? ai cũng có thể hơn mình mà đúng không?

ừ , nhưng mình chưa nhìn thấy cái sự học hỏi trao đổi vui chơi được thể hiện
nếu là mình mà ai đó lịch sự năn nỉ xin 1 đoạn code nhỏ bé như này
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 .
thì mình không ngại gì mà từ chối cả . Vì họ đang chờ để học tập mình với sự cầu tiến
Nhưng xã hội vốn đa dạng mà , mình đâu thể đòi hỏi người khác cũng phải cư xử như mình được
Nên nếu đã từ chối giúp 1 đoạn code thì thôi mình chịu , chỉ buồn cho khẩu hiệu .......

học hỏi trao đổi vui chơi là chính
 
Upvote 0
Đề Nghị Các Bạn Thực hiện theo Tôn chỉ Mục đích Bài #1 nha..

Chúc Vui Chơi Trí Tuệ , Hòa Bình & Vui Vẻ

Thân
 
Upvote 0
Đệ 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)^^.
[GPEcode=vb]
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


[/GPEcode]
Hình như nó lỗi với File Tiếng Việt có dấu ...Bạn thử coi lại xem
 
Upvote 0
Mình có kiểm tra rồi, không phát sinh lỗi, bạn có thể nói rõ lỗi ở dòng code nào và lỗi ra sao không.
(trong code mình đã xử lý vấn đề liên quan Unicode)
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
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à

[/B]
 

File đính kèm

  • Capture.jpg
    Capture.jpg
    15 KB · Đọc: 47
Lần chỉnh sửa cuối:
Upvote 0
Mình có kiểm tra rồi, không phát sinh lỗi, bạn có thể nói rõ lỗi ở dòng code nào và lỗi ra sao không.
(trong code mình đã xử lý vấn đề liên quan Unicode)
Thêm dòng sau nữa trong CheckDir là OK tuyệt đối...Cảm ơn Bạn
Mã:
If Right(sFolder, 1) <> "\" Then sFolder = sFolder + "\"
 
Upvote 0
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.
 
Upvote 0
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
[GPECODE=vb]
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
[/GPECODE]

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
[GPECODE=vb]
Function GiaithuaNguoc(n As Long) As Double
If n = 1 Then
GiaithuaNguoc = 1
Else
GiaithuaNguoc = n * GiaithuaNguoc(n - 1)
End If
End Function[/GPECODE]
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
[GPECODE=vb]
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[/GPECODE]

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

[video]https://youtu.be/zBsad01ZyG8[/video]
 
Lần chỉnh sửa cuối:
Upvote 0
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 (đọ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 (đọ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: http://www.sfdp.net/thuthuataccess/Normal.dotm?attredirects=0&d=1
Addin cho Excel: http://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 ở đây.
Ứng dụng ở đây: http://www.sfdp.net/thuthuataccess/demo/democAuth.rar?attredirects=0&d=1
 
Upvote 0
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 (đọ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 (đọ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: http://www.sfdp.net/thuthuataccess/Normal.dotm?attredirects=0&d=1
Addin cho Excel: http://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 ở đây.
Ứng dụng ở đây: http://www.sfdp.net/thuthuataccess/demo/democAuth.rar?attredirects=0&d=1

trong bài viết trên có nhắc tên Doveandrose , rất cảm ơn anh có nhã ý giúp đỡ , nhưng anh làm như vậy e là không đúng khuôn khổ nội quy của diễn đàn này . Thiết nghĩ thành viên BQT nào đi ngang xin cắt bài viết từ chỗ này sang topic mới . Có nhiều cái để chúng ta bàn về gửi truy vấn bất đồng bộ như : cách tạo , sử dụng ,.... Chứ 1 cái file Addin trong Excel chắc khó để diễn tả hết .
 
Upvote 0
Đệ 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)^^.
[GPEcode=vb]
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


[/GPEcode]
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
 
Upvote 0
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:
Mã:
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 (..)):
Mã:
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
 
Upvote 0
Ý 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:
Mã:
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 (..)):
Mã:
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)
Mã:
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
 
Upvote 0
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)
Mã:
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).
 
Upvote 0
Mình thử phát triển code đệ quy dựa trên code mình đã up lên như sau:
[gpecode=vb]
'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



[/gpecode]
 
Lần chỉnh sửa cuối:
Upvote 0
Thêm dòng sau nữa trong CheckDir là OK tuyệt đối...Cảm ơn Bạn
Mã:
If Right(sFolder, 1) <> "\\" Then sFolder = sFolder + "\\"
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 "\").
 
Lần chỉnh sửa cuối:
Upvote 0
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).
Thôi đau đầu quá ta chuyển qua ADO xem tình hình sao
 
Lần chỉnh sửa cuối:
Upvote 0
Mình thử một cách đệ quy theo Fso xem sao:
[gpecode=vb]
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
[/gpecode]
 
Upvote 0
Mình thử một cách đệ quy theo Fso xem sao:
[gpecode=vb]
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
[/gpecode]
Thích tách ra 3 khúc ta cũng chơi 3 khúc xem tình hình sao
Mã:
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
 
Upvote 0
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
[gpecode=vb]
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[/gpecode]

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.
 
Lần chỉnh sửa cuối:
Upvote 0
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
Mạnh Tuy nông dân nhưng chơi pe kiểu hợp chủng quốc Hoa Kỳ ấy ....Bạn nào muốn Bàn cái gì về đệ quy thì cứ Bàn .... còn ta chơi cái mới ta cứ chơi ....Ai vui khúc nào thì chơi ở khúc đó ...Xong

Xin mời các Bạn tham gia code cho Bài #27 này Bằng ADO với 3 yêu cầu trên
 
Lần chỉnh sửa cuối:
Upvote 0
@VMH0307 : bác oánh '\\' mới thấy '\' hiện ra vì bác để code của bác trong PHP code, mà trong PHP '\\' là escape character.
 
Upvote 0
Mạnh Tuy nông dân nhưng chơi pe kiểu hợp chủng quốc Hoa Kỳ ấy ....Bạn nào muốn Bàn cái gì về đệ quy thì cứ Bàn .... còn ta chơi cái mới ta cứ chơi ....Ai vui khúc nào thì chơi ở khúc đó ...Xong

Xin mời các Bạn tham gia code cho Bài #27 này Bằng ADO với 3 yêu cầu trên
Chờ kieu manh xuất chiêu trước, mình đang tò mò việc kieu manh áp dụng đệ quy như thế nào trong trường hợp này.^^
 
Upvote 0
Chờ kieu manh xuất chiêu trước, mình đang tò mò việc kieu manh áp dụng đệ quy như thế nào trong trường hợp này.^^
Câu 1 thì chuyện nhỏ ...còn câu 2,3 thì đang vả mồ hôi hột ...+-+-+-+

Thì Bạn thử câu 1 trước xem tình hình sao...
 
Upvote 0
Câu 1 thì chuyện nhỏ ...còn câu 2,3 thì đang vả mồ hôi hột ...+-+-+-+

Thì Bạn thử câu 1 trước xem tình hình sao...
Vấn đề là mình không hiểu ADO sẽ áp dụng vào đệ quy như thế nào?
Vì theo mình hiểu thì sử dụng ADO để làm việc với dữ liệu sau khi đã có kết nối thôi, tức là nếu so với code bên trên của mình thì nó đang làm nhiệm vụ của hàm GetFile chứ không phải thực hiện trong phần Dequy.
Vậy, kieu manh có thể làm trước để mọi người có cái nhìn tổng quan về ý tưởng của bạn.
 
Upvote 0
Vấn đề là mình không hiểu ADO sẽ áp dụng vào đệ quy như thế nào?
Vì theo mình hiểu thì sử dụng ADO để làm việc với dữ liệu sau khi đã có kết nối thôi, tức là nếu so với code bên trên của mình thì nó đang làm nhiệm vụ của hàm GetFile chứ không phải thực hiện trong phần Dequy.
Vậy, kieu manh có thể làm trước để mọi người có cái nhìn tổng quan về ý tưởng của bạn.
Để từ từ một tẹo ... Nếu vài hôm nữa mà chưa có ai viết câu 1 thì mình sẽ úp code lên cho Bạn tham khảo thêm ... Mình viết OK tuyệt đối rồi đó...

Vấn đề chính ở đây là Mình mở thớt này là nghiên cứu cùng một vấn đề ta có thể xử lý ở nhiều góc độ khác nhau như thế nào ...????!!!!!

Mình úp lên Ai đó sẽ coi ý tưởng xong viết lên thì mục đích khai thác nhiều khía cạnh của Mình Tèo téo teo...

Vui vẻ nha ... Hạ Hồi Mạnh Sẻ úp lên

Thân
 
Lần chỉnh sửa cuối:
Upvote 0
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:\Windows\System32\ADODeQuy.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

Mã:
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
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
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:\Windows\System32\ADODeQuy.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

Mã:
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?
 
Upvote 0
Đề 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...
 
Upvote 0
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:\Windows\System32\ADODeQuy.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

Mã:
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
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.
 

File đính kèm

Upvote 0
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.
Cảm ơn bạn Mình làm theo mẫu tên Sheet mà mình Úp lên ở bài 27 gì đó ...
nhưng mới test File Bạn úp thấy lấy được mà
 

File đính kèm

  • Capture.jpg
    Capture.jpg
    23.4 KB · Đọc: 23
Upvote 0
Upvote 0
Hình như ít Bạn có hứng với Thuật Toán Đệ Quy thì phải...--=0

...

Không phải không có hứng. Maf là bị cụt nguồn hứng.

Do kẹt cái này, không biết phải sử sự thế nào cho vừa ý chủ. Mở lời sợ bị cho là "không tôn trọng tôn chỉ" nên thà câm.

Đề Nghị Các Bạn Thực hiện theo Tôn chỉ Mục đích Bài #1 nha..
...
 
Upvote 0
Không phải không có hứng. Maf là bị cụt nguồn hứng.

Do kẹt cái này, không biết phải sử sự thế nào cho vừa ý chủ. Mở lời sợ bị cho là "không tôn trọng tôn chỉ" nên thà câm.

Bạn cứ vui chơi tẹt ga đi nha ...
Cảm ơn Bạn
 
Lần chỉnh sửa cuối:
Upvote 0

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

Back
Top Bottom