Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
[Hỏi] Import nhiều file Excel vào Table Access
#31
Cách 1 : Làm 3 file tổng hợp của 3 người riêng rẽ rồi làm một file khác tổng hợp của 3 người lại bằng phương pháp copy sheet TongHop ra một Workbook mới để xử lý
Cách 2 : Dùng ADODB hoặc Array để tăng tốc độ, chắc giảm được một nửa thời gian chờ đợi
Lúc nào rảnh thì viết cho
Chữ ký của Xuân Thanh Trăm năm trước thì ta chưa gặp
Trăm năm sau biết gặp được không?
Cuộc đời sắc sắc không không
Thì thôi ta cứ hết lòng vì nhau
ღღღღღTài sản của Xuân Thanh (View All Items) ღღღღღ
Reply
Những người đã cảm ơn vuthaiha90
#32
(26-07-18, 11:59 AM)Xuân Thanh Đã viết: Cách 1 : Làm 3 file tổng hợp của 3 người riêng rẽ rồi làm một file khác tổng hợp của 3 người lại bằng phương pháp copy sheet TongHop ra một Workbook mới để xử lý
Cách 2 : Dùng ADODB hoặc Array để tăng tốc độ, chắc giảm được một nửa thời gian chờ đợi
Lúc nào rảnh thì viết cho

Giảm đc 1 nửa thời gian là e thấy mừng rồi, cảm ơn bác ạ
Chữ ký của vuthaiha90 vuthaiha90,gia nhập Thủ Thuật Access từ 26-02 -16.
Reply
Những người đã cảm ơn
#33
Code excel 1 người tự Tổng hợp - đã tăng tốc Copy Paste:
Mã PHP:
Sub ChonFileG035841()
   Dim i As LongAs Long
   j 
S01.Range("B1000000").End(xlUp).Row
   S01
.Range("B1:B" j).ClearContents
   With Application
.FileDialog(msoFileDialogFilePicker)
       .AllowMultiSelect True
       
.Show
       For i 
1 To .SelectedItems.Count
           S01
.Range("B" i) = .SelectedItems(i)
       Next
   End With
End Sub

Sub ChonFileG034821
()
   Dim i As LongAs Long
   j 
S01.Range("C1000000").End(xlUp).Row
   S01
.Range("C1:C" j).ClearContents
   With Application
.FileDialog(msoFileDialogFilePicker)
       .AllowMultiSelect True
       
.Show
       For i 
1 To .SelectedItems.Count
           S01
.Range("C" i) = .SelectedItems(i)
       Next
   End With
End Sub

Sub TongHop
()
    Application.ScreenUpdating False
    Dim i 
As LongAs Long
    Dim nFile 
As Long
    Dim Wb 
As Workbook
    Dim Ws 
As Worksheet
    Dim cCell 
As Range
    Dim myarray 
As Variant

    
If S01.Range("B1") <> "" Then
    nFile 
S01.Range("B1000").End(xlUp).Row
    
    With S02
        
.Range("A3:FO818").ClearContents
        
For 1 To nFile
            Set Wb 
Workbooks.Open(S01.Range("B" i))
            Set Ws Wb.Worksheets("G035841")
            If 1 Then .Range("A3:A817").Value Ws.Range("B19:B834").Value
            Set cCell 
= .Range("1:1").Find(Ws.Range("C3").Value, , xlValuesxlWhole, , , True)
            If Not cCell Is Nothing Then
                cCell
.Offset(2).Resize(8162).Value Ws.Range("H19:I835").Value
            End 
If
            Wb.Close False
            Set Wb 
Nothing
        Next
        
.Range("B3:B818").Resize(, S02.UsedRange.Columns.Count).NumberFormat "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
    End With

    
If S01.Range("C1") <> "" Then
    nFile 
S01.Range("C1000").End(xlUp).Row
    
    With S02
        
.Range("A821:FO824").ClearContents
        
.Range("A821") = S01.Range("A5")
        .Range("A822") = S01.Range("A6")
        .Range("A823") = S01.Range("A7")
        .Range("A824") = S01.Range("A8")
        For 1 To nFile
            Set Wb 
Workbooks.Open(S01.Range("C" i))
            Set Ws Wb.Worksheets("G034821")
            .Cells(8202) = .Cells(12)
            m Ws.Range("D1000000").End(xlUp).Row
            Set cCell 
= .Range("1:1").Find(Ws.Range("C3").Value, , xlValuesxlWhole, , , True)
            If Not cCell Is Nothing Then
                cCell
.Offset(820).Resize(14).Value Ws.Range("D" ":G" m).Value
                myarray 
= Array(cCell.Offset(820).Resize(14))
                cCell.Offset(820).Resize(41).Value Application.Transpose(myarray)
                cCell.Offset(8201).Resize(13).ClearContents
            End 
If
            Wb.Close False
            Set Wb 
Nothing
        Next
        
.Range("B821:B824").Resize(, S02.UsedRange.Columns.Count).NumberFormat "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
    End With
    End 
If

MsgBox "Xong"
End Sub 
Chữ ký của vuthaiha90 vuthaiha90,gia nhập Thủ Thuật Access từ 26-02 -16.
Reply
Những người đã cảm ơn


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  Cập nhật dữ liệu Access từ dữ liệu nguồn trong Excel subasatran 1 100 11-10-18, 02:53 PM
Bài mới nhất: ongke0711
  Demo Import/Export Excel + Hàm Liệt tên ALL Access maidinhdan 72 10,666 02-10-18, 10:49 AM
Bài mới nhất: hoabattu3387
  Demo Access định dạng adp kết nối với SQL Server dangh5 5 390 08-08-18, 01:35 AM
Bài mới nhất: dangh5
  [Hỏi] Nhiều phần mềm Access dùng chung CSDL ?? vkaccess 10 1,167 05-08-18, 11:20 AM
Bài mới nhất: zebnguyen
  Export Table từ access sang 1 file word có sẵn! cong_agribankPT 55 27,321 02-08-18, 08:26 AM
Bài mới nhất: vuthaiha90

Chuyển nhanh:


User(s) browsing this thread: 1 Guest(s)
Diễn Đàn Thơ Văn Thi Ẩm Lâu|Nhà Hàng Sông Thơ| PMA Nha Trang| Gỗ Acrylic Không Đường Line