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

[Kiều Mạnh]

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...

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

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

Ứng dụng duyệt File trong Folder và SubFolders Open File

Public Sub OpenFilesInSubFolder(ByVal sFolder As String, ByVal InSub As Boolean)
    Dim objsFolder As Object, ObjFile As Object
    With CreateObject("Scripting.FileSystemObject")
        For Each ObjFile In .GetFolder(sFolder).Files
            If .GetExtensionName(ObjFile) Like "xls*" Then
                If Left(ObjFile.Name, 2) <> "~$" Then
                    If ObjFile.Name <> ThisWorkbook.Name Then
                        With Workbooks.Open(ObjFile)
                            .Close False
                        End With
                    End If
                End If
            End If
        Next ObjFile
        If InSub Then
            For Each objsFolder In .GetFolder(sFolder).subFolders
                Call OpenFilesInSubFolder(objsFolder.Path, True)
            Next objsFolder
        End If
    End With
End Sub


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


Public Sub Main()
    Dim Path As String
    Path = ThisWorkbook.Path
    OpenFilesInSubFolder Path, True
End Sub

Với code trên nếu Sub Main mà là False thì sẻ mở hết tất cả các File Excel trong Folder đó ...Còn True thì sẻ mở hết Từ Folder cha, con, cháu ... trong Folder cha...

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

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

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

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

Thân

 

[VMH0307]

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

 

[Kiều Mạnh]

Ý 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

 

[VMH0307]

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).

 

[VMH0307]

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]

 

[VMH0307]

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 + "\\"

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 "\").

 

[Kiều Mạnh]

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

 

[VMH0307]

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]

 

[Kiều Mạnh]

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

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

 

[paulsteigel]

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.

 

[Kiều Mạnh]

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

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 á...)

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

 

[duongcga]

@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.

 

[VMH0307]

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.^^

 

[Kiều Mạnh]

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...

 

[VMH0307]

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.

 

[Kiều Mạnh]

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

 

[Kiều Mạnh]

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

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

 

[VMH0307]

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

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?

 

[Kiều Mạnh]

Đề 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...

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

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

 

[huuthang_bd]

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

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.

 

[Kiều Mạnh]

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à