Update dữ liệu từ file tổng hợp sang các File chi tiết (2 người xem)

[emcha]

Xin chào tất các ACE diễn đàn.
Nhờ các ACE trong diễn đàn viết giùm tôi cái Code update dữ liệu từ File tổng hợp sang các file chi tiết. Tên file chi tiết có trong 1 cột của file tổng hợp. Và File chi tiết đóng. Tôi có gửi kèm thư mục chứa các file. Trân trọng cảm ơn

 

[PacificPR]

Cái này như kiểu là tách riêng ra từng loại máy từ file tổng hợp ra file riêng theo Form mẫu đúng không bạn ./

 

[emcha]

Vâng. Vì khi nhập thì nhập vào File tổng hợp chi phí trước. Khi nhập xong thì nó được update luôn vào các file chi tiết

 

[PacificPR]

Vâng. Vì khi nhập thì nhập vào File tổng hợp chi phí trước. Khi nhập xong thì nó được update luôn vào các file chi tiết

Mình đang tách file ra theo tên máy không biết có đúng không. Bạn kiểm tra lại xem nha

 

[emcha]

Cảm ơn bạn đã giúp.
ý tôi là khi tôi nhập dữ liệu vào File tổng hợp thì dữ liệu đó được cập nhật luôn vào file chi tiết mặc dù File chi tiết vẫn đóng. Hai bảng này ở 2 File khác nhau ah.

 

[emcha]

Cảm ơn bạn đã giúp.
ý tôi là khi tôi nhập dữ liệu vào File tổng hợp thì dữ liệu đó được cập nhật luôn vào file chi tiết mặc dù File chi tiết vẫn đóng. Hai bảng này ở 2 File khác nhau. Và tôi đặt tên file trùng với tên của từng loại thiết bị trong Cột C. Rật mong nhận được sự giúp đỡ

 

[quanluu]

Cảm ơn bạn đã giúp.
ý tôi là khi tôi nhập dữ liệu vào File tổng hợp thì dữ liệu đó được cập nhật luôn vào file chi tiết mặc dù File chi tiết vẫn đóng. Hai bảng này ở 2 File khác nhau. Và tôi đặt tên file trùng với tên của từng loại thiết bị trong Cột C. Rật mong nhận được sự giúp đỡ

Tại sao lại update? tạo 1 file mới ko đc sao? hay file của bạn còn các sheet khác?
Thường thì tôi hay thấy lấy dữ liệu từ file đang đóng, chứ update dữ liệu vào file đang đóng thì ít nghe.
Mở ngầm có đc không vậy? Nếu các file update có mỗi 1 sheet thì tốt nhất là chạy code tạo mới file luôn cho tiện.

 

[emcha]

Các file chi tiết của mình còn nhiều sheet khác. Vâng dúng là mở ngầm.

 

[PacificPR]

Cảm ơn bạn đã giúp.
ý tôi là khi tôi nhập dữ liệu vào File tổng hợp thì dữ liệu đó được cập nhật luôn vào file chi tiết mặc dù File chi tiết vẫn đóng. Hai bảng này ở 2 File khác nhau. Và tôi đặt tên file trùng với tên của từng loại thiết bị trong Cột C. Rật mong nhận được sự giúp đỡ

Rất là xin lỗi bạn mình hiểu update = cập nhật. Chứ anh Quanluu1989 tham gia là bài của bạn có hướng giải quyết rồi đó. Chúc mừng bạn he

 

[quanluu]

Rất là xin lỗi bạn mình hiểu update = cập nhật. Chứ anh Quanluu1989 tham gia là bài của bạn có hướng giải quyết rồi đó. Chúc mừng bạn he

Hi, bạn cứ nói quá. mà update = cập nhật mà?
Bây h mình đang phê, cái này để mai mình thử code xem sao. hi

 

[quanluu]

Các file chi tiết của mình còn nhiều sheet khác. Vâng dúng là mở ngầm.

Bạn thử code này, các file phải nằm trong cùng 1 folder

Sub update()
    Dim cn As Object, rs As Object, arr, lastrow As Integer, wb As Workbook
    Dim Tmp, i As Integer
    Application.ScreenUpdating = False
    lastrow = Range("C65000").End(3).Row
    arr = Range("C7:C" & lastrow).Value
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";")
    Set dic = CreateObject("Scripting.Dictionary")
    With dic
        For i = 1 To UBound(arr)
            Tmp = arr(i, 1)
            If Not .exists(Tmp) Then
                .Add Tmp, i
                Set rs = cn.Execute("select f1, f4, f6, f7, f8, f10 from [Tong hop$B7:K] where f2 like '" & Tmp & "'")
                Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & Tmp & ".xls")
                wb.Sheets("Bao duong sua chua").Range("A4").CopyFromRecordset rs
                rs.Close
                wb.Close True
            End If
        Next
    End With
    cn.Close: Set cn = Nothing: Set rs = Nothing: Set dic = Nothing
    Application.ScreenUpdating = True
End Sub

 

[Kiều Mạnh]

Bạn thử code này, các file phải nằm trong cùng 1 folder

Sub update()
    Dim cn As Object, rs As Object, arr, lastrow As Integer, wb As Workbook
    Dim Tmp, i As Integer
    Application.ScreenUpdating = False
    lastrow = Range("C65000").End(3).Row
    arr = Range("C7:C" & lastrow).Value
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";")
    Set dic = CreateObject("Scripting.Dictionary")
    With dic
        For i = 1 To UBound(arr)
            Tmp = arr(i, 1)
            If Not .exists(Tmp) Then
                .Add Tmp, i
                Set rs = cn.Execute("select f1, f4, f6, f7, f8, f10 from [Tong hop$B7:K] where f2 like '" & Tmp & "'")
                Set wb = [COLOR=#ff0000][B]Workbooks.Open[/B][/COLOR](ThisWorkbook.Path & "\" & Tmp & ".xls")
                wb.Sheets("Bao duong sua chua").Range("A4").CopyFromRecordset rs
                rs.Close
                wb.Close True
            End If
        Next
    End With
    cn.Close: Set cn = Nothing: Set rs = Nothing: Set dic = Nothing
    Application.ScreenUpdating = True
End Sub

Mình mới coi code tại sao dùng ADO mà lại còn sử dụng dòng màu đỏ vậy...Sử dụng Dic lấy Duy nhất tên File xong ghi vào File đó luôn = ADO

ADO ...Nói vậy thôi chứ cứ F, nul, good ...link tinh với mình là tịt

 

[quanluu]

Mình mới coi code tại sao dùng ADO mà lại còn sử dụng dòng màu đỏ vậy...Sử dụng Dic lấy Duy nhất tên File xong ghi vào File đó luôn = ADO

ADO ...Nói vậy thôi chứ cứ F, nul, good ...link tinh với mình là tịt

Ý anh là insert into? em không khoái cái đó lắm với em không dùng bao h. Em dùng ADO để lọc và lấy ra trường cần thiết cho nhanh thui. hi
Mà good là cái gì vấy anh?

 

[Kiều Mạnh]

Ý anh là insert into? em không khoái cái đó lắm với em không dùng bao h. Em dùng ADO để lọc và lấy ra trường cần thiết cho nhanh thui. hi
Mà good là cái gì vấy anh?

viết sai chính tả đó mà gruo gì gì đó ...

 

[emcha]

Mình rất cảm ơn đã giúp đã.
Mình copy code dán vào file Tong hop sua chua mà lối không chạy được. Mình mới chập chững tìm hiểu về VBA mong các bạn giúp

 

[quanluu]

Mình rất cảm ơn đã giúp đã.
Mình copy code dán vào file Tong hop sua chua mà lối không chạy được. Mình mới chập chững tìm hiểu về VBA mong các bạn giúp

Lỗi gì vậy bạn? mình test có vấn đề gì đâu?

 

[emcha]

dầu tiên là Run-time error '3706'

 

[quanluu]

dầu tiên là Run-time error '3706'

Bạn đưa ra mỗi dòng thể thì chịu rùi. File gốc của bạn có giống với file mẫu bạn đưa lên ko? bạn gửi lại 1 file tổng và 1 file con mình coi xem thế nào. Không thì khó bắt bệnh lắm.

 

[emcha]

Nhờ bạn giúp cho mình. Lúc chạy thì bị lỗi mình gửi cả folder lên đây nhé

 

[quanluu]

Nhờ bạn giúp cho mình. Lúc chạy thì bị lỗi mình gửi cả folder lên đây nhé

Mình tải về và chạy có thấy báo lỗi nào đâu nhỉ?
Bạn dùng office bao nhiêu? nếu 2007>> thì thử thay dòng cũ bằng dòng này coi

cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")

 

[emcha]

Cám ơn bạn. Mình sử dụng Office 2016 64 bit nó báo lỗi như thế này. Do mình không biết chụp màn hình. nên mình đánh lỗi này vậy.

Run-time error '-2147467259(80004005)'
Automation error
Unspecified error

 

[quanluu]

Cám ơn bạn. Mình sử dụng Office 2016 nó báo lỗi như thế này. Do mình không biết chụp màn hình. nên mình đánh lỗi này vậy.

Run-time error '-2147467259(80004005)'
Automation error
Unspecified error

Bạn có thể teamview ko? gủi mình id va pas la ok

 

[emcha]

id : 416 032 210
Pass:8f6y6c

 

[emcha]

id : 416 032 210
Pass:8f6y6c

 

[emcha]

Bạn ơi mình muốn hỏi một chút. Mình muốn thêm 1 đoạn code khi tìm trong thư mục mà không thấy file có tên giống như ở cột C thì bỏ qua thực hiện tên tiếp theo.

 

[quanluu]

Bạn ơi mình muốn hỏi một chút. Mình muốn thêm 1 đoạn code khi tìm trong thư mục mà không thấy file có tên giống như ở cột C thì bỏ qua thực hiện tên tiếp theo.

   [COLOR=#000000]Sub update()[/COLOR]    Dim cn As Object, rs As Object, arr, lastrow As Integer, wb As Workbook
    Dim Tmp, i As Integer
    Application.ScreenUpdating = False
    lastrow = Range("C65000").End(3).Row
    arr = Range("C7:C" & lastrow).Value
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";")
    Set dic = CreateObject("Scripting.Dictionary")
    With dic
        For i = 1 To UBound(arr)
            Tmp = arr(i, 1)
            If Not .exists(Tmp) Then
                .Add Tmp, i
                if dir([FONT=Verdana]ThisWorkbook.Path & "\" & Tmp & ".xls"[/FONT][FONT=Verdana]) <> "" then[/FONT]                Set rs = cn.Execute("select f1, f4, f6, f7, f8, f10 from [Tong hop$B7:K] where f2 like '" & Tmp & "'")
                Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & Tmp & ".xls")
                wb.Sheets("Bao duong sua chua").Range("A4").CopyFromRecordset rs
                rs.Close
                wb.Close True
                end if
            End If
        Next
    End With
    cn.Close: Set cn = Nothing: Set rs = Nothing: Set dic = Nothing
    Application.ScreenUpdating = True
End Sub

 

[emcha]

Cảm ơn bạn đã giúp đỡ. Mình còn vấn đề này muốn hỏi. Nếu chỉ cần cập nhật mỗi dòng cuối cùng của bản tổng hợp sang file có tên ở cột C của dòng đó thì Code phải thay đổi như thế nào.

 

[emcha]

Mong mọi người giúp đỡ
Nếu chỉ cần cập nhật mỗi dòng cuối cùng của bản tổng hợp sang file có tên ở cột C của dòng đó thì Code phải thay đổi như thế nào