Tổng Hợp N + 1 Files Trong Folder Không Sử Dụng ADO, DAO và Workbooks.Open (1 người xem)

Kiều Mạnh · 7/6/16

Xuất phát từ ý tưởng ở 2 thớt sau:

http://www.giaiphapexcel.com/forum/...iệu-từ-nhiều-file-khác-nhau-vào-file-tổng-hợp

http://www.giaiphapexcel.com/forum/...-excel-đang-đóng-bằng-ADO&p=719556#post719556

Mạnh lập thớt này để nghiên cứu học tập thêm và sau đó là trả bài cho Bạn doveandrose
sau một thời gian mạnh Theo doveandrose hoc code ....

I/ Như tiều đề của thớt này ta sẻ tổng hợp tất cả các Files trong Folder mà không xác định tên File, tổng số File có bao nhiêu trong Folder chơi hêt ....*.xls, *.xlsb,*.xlsx ....

1/ Tên Sheets("THA") là tên Sheet cần tổng hợp

2/ Vùng dữ liệu cần tổng hợp là [A14:M100]

3/ Lấy hết lên gán lên File tổng hợp nối tiếp xuống

II/ Xong câu I ta chuyển qua câu II

1/ vẫn như tiêu đề ta sẻ tổng hợp file có Pass Open lấy dữ liệu của 1 Files mà biết:

1/ Tên Sheets("THA") là tên Sheet cần tổng hợp

2/ Vùng dữ liệu cần tổng hợp là [A14:M100]

3/ Pass Open là: 1

4/ lấy hết lên gán lên File tổng hợp

Câu này có 2 cách : 1 là nhập pass = tay , 2 là cho pass vào code luôn....Ai thích kiểu nào ta chơi kiểu đó ...

Xin mời các Bạn có nhả hứng tham gia một tí cho vui ....sau đó Mạnh sẻ úp đáp án trả Bài cho Thầy doveandrose ....Vì đã nghiên cứ từ những thuất toán của thầy ....
--=0

Files giả lập kèm theo

Sau đó nữa nếu nổi gió lên ta chơi tiếp các kiểu ... _+)(9

$-.,\;$

Xin cảm ơn

Kiều Mạnh · 8/6/16

ndu96081631 đã viết:
Xem từ bài 13 trở đi...

Thì bài 13 link sau Anh Viết như sau:

http://www.giaiphapexcel.com/forum/...ro-4-để-lấy-dữ-liệu-từ-1-file-đang-đóng/page2

Mã:

[COLOR=#0000BB][FONT=monospace]Sub GetData[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sFile [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]String[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sSheet [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]String[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sAddr [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]String[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Target [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Range[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
  [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dim pLink [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]String
  [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Len[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dir[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sFile[/FONT][/COLOR][COLOR=#007700][FONT=monospace])) [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then
    pLink [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"'" [/FONT][/COLOR][COLOR=#007700][FONT=monospace]& [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Replace[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sFile[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dir[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sFile[/FONT][/COLOR][COLOR=#007700][FONT=monospace]), [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"[" [/FONT][/COLOR][COLOR=#007700][FONT=monospace]& [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dir[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sFile[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) & [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"]"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) & [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sSheet [/FONT][/COLOR][COLOR=#007700][FONT=monospace]& [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"'!"
    [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]With Range[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sAddr[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
      [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]With Target[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Resize[/FONT][/COLOR][COLOR=#007700][FONT=monospace](.[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Rows[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Count[/FONT][/COLOR][COLOR=#007700][FONT=monospace], .[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Columns[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Count[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
        .[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]FormulaArray [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"=" [/FONT][/COLOR][COLOR=#007700][FONT=monospace]& [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]pLink [/FONT][/COLOR][COLOR=#007700][FONT=monospace]& [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sAddr
        [/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Value [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= .[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Value
      End With
    End With
  End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End Sub  [/FONT][/COLOR]

Còn code đó Em học như đã nói ở bài 1 của doveandrose

ndu96081631 · 8/6/16

kieu manh đã viết:

Thì bài 13 link sau Anh Viết như sau:

http://www.giaiphapexcel.com/forum/...ro-4-để-lấy-dữ-liệu-từ-1-file-đang-đóng/page2

Mã:

[COLOR=#0000BB][FONT=monospace]Sub GetData[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sFile [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]String[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sSheet [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]String[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sAddr [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]String[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Target [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Range[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
  [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dim pLink [/FONT][/COLOR][COLOR=#007700][FONT=monospace]As [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]String
  [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Len[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dir[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sFile[/FONT][/COLOR][COLOR=#007700][FONT=monospace])) [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then
    pLink [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"'" [/FONT][/COLOR][COLOR=#007700][FONT=monospace]& [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Replace[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sFile[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dir[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sFile[/FONT][/COLOR][COLOR=#007700][FONT=monospace]), [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"[" [/FONT][/COLOR][COLOR=#007700][FONT=monospace]& [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Dir[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sFile[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) & [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"]"[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) & [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sSheet [/FONT][/COLOR][COLOR=#007700][FONT=monospace]& [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"'!"
    [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]With Range[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sAddr[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
      [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]With Target[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Resize[/FONT][/COLOR][COLOR=#007700][FONT=monospace](.[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Rows[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Count[/FONT][/COLOR][COLOR=#007700][FONT=monospace], .[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Columns[/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Count[/FONT][/COLOR][COLOR=#007700][FONT=monospace])
        .[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]FormulaArray [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= [/FONT][/COLOR][COLOR=#DD0000][FONT=monospace]"=" [/FONT][/COLOR][COLOR=#007700][FONT=monospace]& [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]pLink [/FONT][/COLOR][COLOR=#007700][FONT=monospace]& [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sAddr
        [/FONT][/COLOR][COLOR=#007700][FONT=monospace].[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Value [/FONT][/COLOR][COLOR=#007700][FONT=monospace]= .[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Value
      End With
    End With
  End [/FONT][/COLOR][COLOR=#007700][FONT=monospace]If
[/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]End Sub  [/FONT][/COLOR]

Còn code đó Em học như đã nói ở bài 1 của doveandrose

Hi... Hi... vậy chắc mình nhìn nhầm rồi, code bạn và mình chẳng có giống nhau đâu.

Hoàng Trọng Nghĩa · 8/6/16

Nếu các file lấy dữ liệu có password open file thì sao ta, vì đang viết bài trên điện thoại nên không thể test được. )*&^)

Kiều Mạnh · 8/6/16

Hoàng Trọng Nghĩa đã viết:
Nếu các file lấy dữ liệu có password open file thì sao ta, vì đang viết bài trên điện thoại nên không thể test được.

Từ từ một tẹo Bạn Hồi sau Mạnh sẻ Úp đáp Án của Mạnh .....
Giống như mấy bài đàu đó có ai code là Mạnh code liền ..... --=0

Kiều Mạnh · 9/6/16

ndu96081631 đã viết:
Hi... Hi... vậy chắc mình nhìn nhầm rồi, code bạn và mình chẳng có giống nhau đâu.

Em mới coi lại code sau của Anh thì thấy như sau:

Mã:

[COLOR=#0000BB]Sub GetData[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]sFile [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000BB]String[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]sSheet [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000BB]String[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]sAddr [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000BB]String[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]Target [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000BB]Range[/COLOR][COLOR=#007700])
  [/COLOR][COLOR=#0000BB]Dim pLink [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000BB]String
  [/COLOR][COLOR=#007700]If [/COLOR][COLOR=#0000BB]Len[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]Dir[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]sFile[/COLOR][COLOR=#007700])) [/COLOR][COLOR=#0000BB]Then
    pLink [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#DD0000]"'" [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#0000BB]Replace[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]sFile[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]Dir[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]sFile[/COLOR][COLOR=#007700]), [/COLOR][COLOR=#DD0000]"[" [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#0000BB]Dir[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]sFile[/COLOR][COLOR=#007700]) & [/COLOR][COLOR=#DD0000]"]"[/COLOR][COLOR=#007700]) & [/COLOR][COLOR=#0000BB]sSheet [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#DD0000]"'!"
    [/COLOR][COLOR=#0000BB]With Range[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]sAddr[/COLOR][COLOR=#007700])
      [/COLOR][COLOR=#0000BB]With Target[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Resize[/COLOR][COLOR=#007700](.[/COLOR][COLOR=#0000BB]Rows[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Count[/COLOR][COLOR=#007700], .[/COLOR][COLOR=#0000BB]Columns[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Count[/COLOR][COLOR=#007700])
        .[/COLOR][COLOR=#0000BB]FormulaArray [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#DD0000]"=" [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#0000BB]pLink [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#0000BB]sAddr
        [/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Value [/COLOR][COLOR=#007700]= .[/COLOR][COLOR=#0000BB]Value
      End With
    End With
  End [/COLOR][COLOR=#007700]If
[/COLOR][COLOR=#0000BB]End Sub 
[/COLOR]

Giống Anh về cách sử dụng FormulaArray ....

1/đề lấy dữ liệu Anh sử dụng Replace để xử lý đường dẫn của File sẻ Tèo với Folder là tiếng việt có dấu ...

2/ Khi cho Vùng dữ liệu cần lấy Nhiều hơn so với thực tế có thì nó lấy lên phần dữ liệu cần lấy và phần O tròn như quả trứng gà ko Thôi ...

3/ Code Anh viết chỉ áp dụng cho lấy dữ liệu một File

4/ quả thực ý tưởng FormulaArray Là Giống code Anh viết ....Nhưng khác nhau là:

- Code Em viết lấy N +1 File Excel trong Folder mà không xác đinh tên file + số lượng

- Em sử dụng Fso để xử lý thay vì Replace thì lấy được trong Folder là tiếng Việt có dấu ....

- Em thêm điều Kiện lọc (Col) gán vào Mãng xử lý được O tròn như quả trứng gà ...

- Quả thực Em học từ Ý tưởng từ code bài 4 link sau:

http://www.giaiphapexcel.com/forum/...link-dữ-liệu-tự-động-từ-nhiều-file-vào-1-file

Như vậy bài #20 Anh Nói là có phần đúng....

Em cảm ơn Anh rất nhiều nhờ Bài 20 của Anh mà Em nghiền ngẫm tới lui code của Anh và học thêm nhiều điều hay ....Mai mốt gặp lại Em mời vài chai nha ... --=0

Lê Duy Thương · 9/6/16

kieu manh đã viết:
Em cảm ơn Anh rất nhiều nhờ Bài 20 của Anh mà Em nghiền ngẫm tới lui code của Anh và học thêm nhiều điều hay ....Mai mốt gặp lại Em mời vài chai nha ...

Vậy Manh đưa code final của mạnh lên đây kèm file đính kèm để cho mình thử ngâm cứu với nhé. Hôm nay đang thử chạy trên Win10 &office 2016 x64 xem sao --=0

Thông thường dạng dữ liệu này tôi hay dùng ADO để lấy.
Nếu lấy 1 sheet của file đang đóng tôi sẽ dung ADO của anh Tuấn viết.
Nếu lấy nhiều sheet của file đang đóng tôi sẽ dùng ADO của anh Chim Hồng viết.
Nếu code của mạnh mà không vẫn đề khi chạy trên win và office nới trên thì chúng ta lại có thêm 1 giải pháp tuyệt vời nữa.

Kiều Mạnh · 9/6/16

Lê Duy Thương đã viết:
Vậy Manh đưa code final của mạnh lên đây kèm file đính kèm để cho mình thử ngâm cứu với nhé. Hôm nay đang thử chạy trên Win10 &office 2016 x64 xem sao
Thông thường dạng dữ liệu này tôi hay dùng ADO để lấy.
Nếu lấy 1 sheet của file đang đóng tôi sẽ dung ADO của anh Tuấn viết.
Nếu lấy nhiều sheet của file đang đóng tôi sẽ dùng ADO của anh Chim Hồng viết.
Nếu code của mạnh mà không vẫn đề khi chạy trên win và office nới trên thì chúng ta lại có thêm 1 giải pháp tuyệt vời nữa.

Thì có trên đây rồi mà ...Anh tài File bài 1 về Test Nha

Mã:

Public Sub GetDataFiles(strPath As String, SheetName As String, _
                        DataRange As String, Col As Long, Target As Range)
                         
    Static Fso As Object, ObjFile As Object
    Dim Arr(), Res(), i As Long, j As Long, k As Long
    Dim FilePath As String, Sht As String
    If Excel4MacroSheets.Count = 0 Then
        Application.Excel4MacroSheets.Add.Name = "Temp"
        Sheets("Temp").Visible = 2
    End If
    If Fso Is Nothing Then Set Fso = CreateObject("Scripting.FileSystemObject")
    For Each ObjFile In Fso.GetFolder(strPath).Files
        If Fso.GetExtensionName(ObjFile) Like "xls*" Then
            If Left(ObjFile.Name, 2) <> "~$" Then
                If ObjFile.Name <> ThisWorkbook.Name Then
                    Sht = SheetName & "'!" & DataRange
                    FilePath = "='" & Fso.GetParentFolderName(ObjFile) _
                             & "\[" & Fso.GetFileName(ObjFile) & "]" & Sht
                    With Sheets("Temp").Range(DataRange)
                         .FormulaArray = FilePath
                         .Value = .Value
                         Res = .Value
                        .ClearContents
                    End With
                    ReDim Preserve Arr(1 To UBound(Res, 1), 1 To UBound(Res, 2))
                    For i = 1 To UBound(Res, 1)
                        If Res(i, Col) <> Empty Then
                            k = k + 1
                            For j = 1 To UBound(Res, 2)
                                Arr(k, j) = Res(i, j)
                            Next
                        End If
                    Next
                End If
            End If
        End If
    Next
    If k Then Target.Resize(k, UBound(Res, 2)).Value = Arr
    Set Fso = Nothing
End Sub


Public Sub Main()
    Dim Path As String, Sht As String, Data As String
    Path = ThisWorkbook.Path                    ''duong dan tong hop File
    Sht = "THA"                                 ''Ten Sheet can Tong Hop
    Data = ("A4:M100")                          ''Vung du lieu can lay
    ActiveSheet.UsedRange.ClearContents
    GetDataFiles Path, Sht, Data, 2, [A5]        ''2 = Cot Loc theo dieu kien co du lieu
End Sub

Còn lấy 1 File Em viết trên GPE rồi ... Anh tham khảo Thêm
Nếu Thích ADO Tộng Hợp File duyệt đệ quy nữa thì Từ từ Em Úp

http://www.giaiphapexcel.com/forum/...ông-Sử-Dụng-ADO-Macro4-Và-Workbook-Open/page2

Lê Duy Thương · 9/6/16

code của mạnh rất lạ là sau khi chạy code 1 lần. tôi xóa luôn sheet temp và bỏ đoạn code
này nó vẫn ra kết quả
'If Excel4MacroSheets.Count = 0 Then
' Application.Excel4MacroSheets.Add.Name = "Temp"
' Sheets("Temp").Visible = 2
' End If
không hiểu luôn +-+-+-+

huuthang_bd · 9/6/16

Lê Duy Thương đã viết:
code của mạnh rất lạ là sau khi chạy code 1 lần. tôi xóa luôn sheet temp và bỏ đoạn code
này nó vẫn ra kết quả
'If Excel4MacroSheets.Count = 0 Then
' Application.Excel4MacroSheets.Add.Name = "Temp"
' Sheets("Temp").Visible = 2
' End If
không hiểu luôn

Làm gì có nhỉ.

Giống Anh về cách sử dụng FormulaArray ....

Tôi nghĩ chỉ cần như vậy thì gọi là giống được rồi. Phần còn lại chỉ là hoa lá cành mà thôi.

Lê Duy Thương · 9/6/16

huuthang_bd đã viết:
Làm gì có nhỉ.

Tôi nghĩ chỉ cần như vậy thì gọi là giống được rồi. Phần còn lại chỉ là hoa lá cành mà thôi.

Nói có sách mách có chứng
huuthang_bd có thể kiểm chứng ở file đính kèm.
tôi đã chép folder này sang 1 máy khác và vẫn chạy bình thường --=0

huuthang_bd · 9/6/16

Lê Duy Thương đã viết:
Nói có sách mách có chứng
huuthang_bd có thể kiểm chứng ở file đính kèm.
tôi đã chép folder này sang 1 máy khác và vẫn chạy bình thường

Bằng chứng này không đáng tin rồi --=0

[video=youtube;8PJ9DVUnono]https://www.youtube.com/watch?v=8PJ9DVUnono&feature=youtu.be[/video]

Lê Duy Thương · 9/6/16

huuthang_bd đã viết:
Bằng chứng này không đáng tin rồi
[video=youtube;8PJ9DVUnono]https://www.youtube.com/watch?v=8PJ9DVUnono&feature=youtu.be[/video]

ủa sao mình không thấy được sheet temp như của hữu thắng ta ?. để tối tôi mở bằng office 2010 ở máy nhad xem sao.

huuthang_bd · 9/6/16

Lê Duy Thương đã viết:
ủa sao mình không thấy được sheet temp như của hữu thắng ta ?. để tối tôi mở bằng office 2010 ở máy nhad xem sao.

Sheet đó ở trạng thái siêu ẩn. Phải unhide bằng code mới được.

Lê Duy Thương · 9/6/16

huuthang_bd đã viết:
Sheet đó ở trạng thái siêu ẩn. Phải unhide bằng code mới được.

huuthang có code show sheet khác không . tôi dùng code này thì show được các sheet nhưng cái sheet ms macro4 kia không ăn thua
Sub UnhideSheet()
Dim Ws As Worksheet
For Each Ws In ActiveWorkbook.Worksheets
Ws.Visible = True
Next
End Sub +-+-+-+

kha kha
đã tìm thấy em ấy rồi
sửa lại code của mạnh là nó lòi mặt ra rất dễ thương
If Excel4MacroSheets.Count >= 1 Then

Sheets("Temp").Visible = -1
End If

huuthang_bd · 9/6/16

Lê Duy Thương đã viết:
huuthang có code show sheet khác không . tôi dùng code này thì show được các sheet nhưng cái sheet ms macro4 kia không ăn thua
Sub UnhideSheet()
Dim Ws As Worksheet
For Each Ws In ActiveWorkbook.Worksheets
Ws.Visible = True
Next
End Sub
kha kha
đã tìm thấy em ấy rồi
sửa lại code của mạnh là nó lòi mặt ra rất dễ thương
If Excel4MacroSheets.Count >= 1 Then

Sheets("Temp").Visible = -1
End If

Phải vầy mới được.

PHP:

Sub UnhideAllSheet()
Dim Sh As Object
For Each Sh In ActiveWorkbook.Sheets
    Sh.Visible = xlSheetVisible
Next
End Sub

Sheet Macro4 không phải là WorkSheet nên code của bạn không duyệt qua nó.

Kiều Mạnh · 9/6/16

huuthang_bd đã viết:
Phải vầy mới được.

PHP:

Sub UnhideAllSheet() Dim Sh As Object For Each Sh In ActiveWorkbook.Sheets Sh.Visible = xlSheetVisible Next End Sub

Sheet Macro4 không phải là WorkSheet nên code của bạn không duyệt qua nó.

Chỉ Cần vậy Thôi....Bạn

Mã:

Sub Unhide()
Sheets("Temp").Visible = 1
End Sub

Lê Duy Thương · 9/6/16

Cái mạnh đang nói là sheet temp trong file gốc của mạnh
Cái đó tôi xóa mất tiêu rồi.chỉ còn mỗi sheet temp bằng MS_ macro4 thôi.
Vơi lại code của mạnh chỉ có giá trị trong file đó thôi.nếu muốn show tất cả các macro sheet thì không được.
Hôm nay rãnh lại khám phá thêm được vài chiêu.kha kha.
cám ơn tất cả anh em . hẹn gặp lại ở SN lần 10 . ta cụng ly cho sướng nhá

giaiphap · 17/6/16

Chủ đề này không còn cách nào khác nửa sao bác Kieumanh, mấy ngày nay hóng xem tiếp nhưng dài cả cổ chẳng thấy bác xuất chiêu.

Lê Duy Thương · 17/6/16

giaiphap đã viết:
Chủ đề này không còn cách nào khác nửa sao bác Kieumanh, mấy ngày nay hóng xem tiếp nhưng dài cả cổ chẳng thấy bác xuất chiêu.

Mình cũng đang chờ cái vụ lấy dữ liệu ở file có pass đây.Tuy nhiên code của Kieumanhchạy cũng ổn đấy chứ.

Kiều Mạnh · 18/6/16

Lê Duy Thương đã viết:
Mình cũng đang chờ cái vụ lấy dữ liệu ở file có pass đây.Tuy nhiên code của Kieumanhchạy cũng ổn đấy chứ.

Anh thử xài hàm sau Em viết sử dụng chung nhất muôn lấy dữ liệu lên cũng ok hay gán nó vào cái mảng cũng

được , lấy dữ liệu bất cứ 1 File nào nếu đúng tên sheet thì nó lấy nếu sai thì nó cho 1 list cho mà chọn là ok...

Còn nếu có pass Open nữa thì nó hiện lên cho mà nhập pass....

Còn nếu muốn pass nữa thì thêm 2 dòng code là xong... --=0

Nếu cho vùng dữ liệu 65536 thì nó lấy tốc độ châm hơn ADO nhanh hơn Workbooks.Open...
Còn nếu cho nó dò tìm dòng cuối và gán vào thì tốc độ nhanh hơn như vậy Vùng lấy VD: [A10:M] ...là xong ...Em mới học của hpkhuong bài 7 đó cái vụ [A1] ...đó ... --=0

Mã:

Public Sub GetDataFile(strPath As String, SheetName As String, DataRange As String, Res())
    Dim Fso As Object, FilePath As String, Sht As String
    If Excel4MacroSheets.Count = 0 Then
        Application.Excel4MacroSheets.Add.Name = "Temp"
        Sheets("Temp").Visible = 2
    End If
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Sht = SheetName & "'!" & DataRange
    FilePath = "='" & Fso.GetParentFolderName(strPath) _
             & "\[" & Fso.GetFilename(strPath) & "]" & Sht
    With Sheets("Temp").Range(DataRange)
         .FormulaArray = FilePath
         .Value = .Value
         .Replace 0, "", 1, , , 0
         Res = .Value
        .ClearContents
    End With
    Set Fso = Nothing
End Sub
''
Public Sub Main()
    Dim Arr(), Path As String, Sht As String, Data As String
    Path = ThisWorkbook.Path & "\Pass=1.xlsx"   ''Ten File can Lay 
    ''Path = Application.GetOpenFilename("Excel Files,*.xl*")
    Sht = "THA"                                 ''Ten Sheet can lay
    Data = ("A6:J100")                          ''Vung du lieu can lay
    GetDataFile Path, Sht, Data, Arr()
    ActiveSheet.UsedRange.ClearContents
    Range("A6").Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr
End Sub

Tổng Hợp N + 1 Files Trong Folder Không Sử Dụng ADO, DAO và Workbooks.Open (1 người xem)

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

I don't program, I beat code into submission!!!

File đính kèm

I don't program, I beat code into submission!!!

Huyền thoại GPE

Chuyên gia GPE

I don't program, I beat code into submission!!!

I don't program, I beat code into submission!!!

Cạo lấy gì gội (Dịch quá không gội được)

I don't program, I beat code into submission!!!

Cạo lấy gì gội (Dịch quá không gội được)

Chuyên gia GPE

Cạo lấy gì gội (Dịch quá không gội được)

File đính kèm

Chuyên gia GPE

Cạo lấy gì gội (Dịch quá không gội được)

Chuyên gia GPE

Cạo lấy gì gội (Dịch quá không gội được)

Chuyên gia GPE

I don't program, I beat code into submission!!!

Cạo lấy gì gội (Dịch quá không gội được)

==(^o^)==

Cạo lấy gì gội (Dịch quá không gội được)

I don't program, I beat code into submission!!!

Đếm ngược thời gian