Giúp đỡ sửa VBA lấy dữ liệu từ file Excel khác đang đóng

Chia sẻ bởi:hands

★★★★★

‹ Lấy DM duy nhất theo 2 cột... Nhờ các bạn sửa giúp code tìm... ›

Quảng cáo

Hiện mình muốn sửa Code VBA bên dưới để lấy dữ liệu từ file khác.

Rất mong anh chị giúp đỡ

Lý do: VBA lấy dữ liệu chạy từng sub 1 để lấy dữ liệu của từng Sheet, nên thỉnh thoảng phát sinh lỗi và nhìn rất rối

Dim vFile, FileItem, aRes, Target As Range, Sh
Dim FileName As String, SheetName As String, RangeAddress As String
On Error Resume Next
  vFile = Application.GetOpenFilename("Excel File, *.xls; *.xlsb; *.xlsm", , , , True)

If TypeName(vFile) = "Variant()" Then
    SheetName = "HinhSu": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_HS.Range("B" & iCuoi(ThongKe_HS, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
'--------------------------------------------------------------------------------
 If TypeName(vFile) = "Variant()" Then
    SheetName = "DanSu": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_DS.Range("B" & iCuoi(ThongKe_DS, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If

'--------------------------------------------------------------------------------

If TypeName(vFile) = "Variant()" Then
    SheetName = "HonNhan": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_HN.Range("B" & iCuoi(ThongKe_HN, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
'--------------------------------------------------------------------------------

If TypeName(vFile) = "Variant()" Then
    SheetName = "LaoDong": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_LD.Range("B" & iCuoi(ThongKe_LD, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
  '--------------------------------------------------------------------------------
 If TypeName(vFile) = "Variant()" Then
    SheetName = "HoaGiai": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_HG.Range("B" & iCuoi(ThongKe_HG, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
'--------------------------------------------------------------------------------
 If TypeName(vFile) = "Variant()" Then
    SheetName = "THA_HS": RangeAddress = "B6:W9999"
    For Each FileItem In vFile
    aRes = Nothing
      FileName = CStr(FileItem)
      If UCase(FileName) <> UCase(ThisWorkbook.FullName) Then
        aRes = GetData(FileName, SheetName, RangeAddress, False, False)
        If IsArray(aRes) Then
          Set Target = ThongKe_THA.Range("B" & iCuoi(ThongKe_THA, 4) + 1).End(xlUp).Offset(1)
          Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
        End If
      End If
    Next
  End If
End Sub

Mình thấy bạn lấy tất cả dữ liệu từ file nguồn sang file đích thì cần gì chạy code nhỉ, cứ copy file là xong mà.

Mình muốn sử dụng chức năng đó để khôi phục dữ liệu, nhiều trường hợp chỉ lấy 1 phần dữ liệu gốc, nên nếu copy thủ công rất tốn thời gian và dễ bị lỗi

Bạn tham khảo, không biết có đúng ý không.

Khóa học SprinGO phù hợp

Khóa học Power PI – Ứng dung trong Nhân sự

TỔNG QUAN KHÓA HỌC: POWER BI CHO NGÀNH NHÂN SỰ Khóa học Power BI cho Nhân sự được thiết kế dành riêng cho các...

Xem khóa học

★★★★★ 5 ★ 1 👤 6 ▥ 0

‹ Lấy DM duy nhất theo 2 cột =... Nhờ các bạn sửa giúp code tìm kiếm... ›

Quảng cáo

Bạn nên đọc

Tìm ngày giờ kết thúc dự kiến

Tổng hợp file Excel tính giá thành sản phẩm cho doanh nghiệp sản xuất, gia công, xây lắp

Hướng dẫn xử lý file Excel chậm

Công thức quy đổi lương NET sang GROSS

Tính thưởng lũy tiến

Cách tách chuỗi trong dấu ngoặc Excel bằng công thức và Flash Fill

6 Responses

hands says:

12/01/2023 at 5:54 pm

Hôm bữa code chạy rất tốt và hoàn hảo. Tuy nhiên, phát sinh khi File exel nguồn có nhiều Sheet khác nhau gồm: Sheet dùng để lấy dữ liệu (HinhSu, DanSu, HonNhan, LaoDong, THA_HS) và Sheet không dùng lấy dữ liệu (Sheet1, Sheet2, Sheet3) thì bị phát sinh lỗi.
Vậy mong anh @Hoàng Tuấn 868 và ace GPE sửa lại code vba để khắc phục lỗi giúp mình với
Rất mong anh giúp đỡ và cảm ơn anh nhiều

Nghịch tí. Tạm thời nếu ổn thì dùng tạm. Và chờ tin tốt hoặc tin xấu của bác sĩ chính nhé.
Thêm vào: If lrn > 5 Then
mn = sn.Range("A6:W" & lrn): sd.Range("A" & lrd + 1).Resize(lrn – 5, 23) = mn
'sd.Range("A" & lrd + 1).Resize(lrn – 5, 23).Borders.LineStyle = True
End If
Dấu nháy này nữa: ' j = j + 1

Vì nghịch nên trong quá trình có gì bối zối, mong …

Giả sử số Sheet file exel lấy dữ liệu và file nhập dữ liệu giống nhau về số lượng và tên Sheet thì sao vậy bạn

Không hiểu lắm. Nếu giống nhau y hệt thì làm gì có lỗi chứ, có bao nhiêu cứ liệt kê vào Or này nè.
```
If Sheets(ktts).Name = "HinhSu" Or Sheets(ktts).Name = "DanSu" Or Sheets(ktts).Name = "HonNhan" Or Sheets(ktts).Name = "LaoDong" Or Sheets(ktts).Name = "HoaGiai" Or Sheets(ktts).Name = "THA_HS" Then
```
Mình đã liệt kê hết rồi, khi số lượng sheet 2 file bằng nhau thì phát sinh lỗi

Thêm 3 dấu nháy này rồi test cả 2 trường hợp: thừa sheet và bằng sheet xem sao.

'On Error Resume Next
……………………………………………………..
'On Error GoTo 0
'If i = 0 Then Exit Sub

Nhìn qua thì có thể do dòng code này (màu xanh) làm phát sinh lỗi khi cả 2 file có thêm các sheet1,2,3…
Bên "Nguồn" có thêm Sheet1, bên "Đích" cũng có thêm Sheet1 => chạy các dòng code kế tiếp mà 2 sheets này không có dữ liệu gì cả.
1745

Duyệt từng Sheet – lấy tên – so sánh -> phát sinh lỗi nếu phát sinh thêm tên sheet bất kỳ ("Sheet1", "ABC"…) mà không phải là Sheet lấy dữ liệu. Theo tôi làm thì sẽ khai báo cố định luôn tên các sheet cần lấy dữ liệu.
```
Dim strShtNames As String
strShtNames = "HinhSu,DanSu,HonNhan,LaoDong,HoaGiai,THA_HS"
```
Lý do:
Bạn đã thiết kế ứng dụng cố định cho các công việc như vậy thì cũng phải thiết kế cố định luôn tên các sheet chứ đâu thể hứng lên thì đổi tên, rồi phải đổi tên đồng bộ cả 2 file nguồn và đích.
Một khi đã có chuỗi tên sheet cố định thì chỉ cần duyệt 1 vòng mảng tên sheet rồi gán giá trị luôn.

Anh viết luôn em tham khảo với
Hihi

File này dựa trên code của bạn @Hoàng Tuấn 868 , tôi chỉ sửa lại một chút theo cách của tôi.
Còn mấy trường hợp không nằm trong pham vi xử lý của file này:
– Số cột thay đổi, thứ tự thay đổi.
– Copy dữ liệu không có kiểm tra trùng.
– … (chưa tìm ra)
Cứ xài tạm vậy thôi.

Reply
hands says:

15/01/2023 at 10:20 am

Cảm ơn bạn đã hỗ trợ. Cho mình hỏi sao khi lấy dữ liệu nó chỉ lấy được ở Sheet HinhSu, các Sheet như DanSu, HonNhan, LaoDong, HoaGiai, THA_HS thì không lấy được dữ liệu vậy.
Mình xin giải thích lại mục đích như sau:
File nguồn dữ liệu: Có các sheet giống File dùng để lấy dữ liệu
Tuy nhiên khi lấy dữ liệu thì có 2 Sheet bên File nguồn (có dữ liệu) nhưng không lấy dữ qua File dùng để lấy dữ liệu (ngữ nguyên)
Tức là Các Sheet HinhSu, DanSu, HonNhan, LaoDong, HoaGiai, THA_HS lấy dữ liệu, Các Sheet1, Sheet2 không lấy dữ liệu
Mình xin cảm ơn

À tại trong code tôi chạy test thử 1 sheet thôi mà quên sửa lại như cũ.
Bạn kiếm dòng code như trong hình (dòng màu xanh) – Bỏ số 0 và dấu nháy đơn đi là được rồi.
1836
Còn các vấn đề sau của bạn thì nó vẫn chạy đúng như yêu cầu đó. Chỉ lấy dữ liệu những Sheet nào bạn gõ trong ô B1 – Sheet "Settings".

Reply

hands says:

18/01/2023 at 8:34 am

Bạn thử nghiên cứu xem nhé.

Sub STARTRP()
getSpeed (True)
  Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
sSourceFile = "C:UsersDBCOneDriveDATATên file.Định dạng" ' Chọn đường dẫn đến One Driver
sDestinationFile = "C:Thư mục của bạn Tên file.Định dạng"
fso.COPYFile sSourceFile, sDestinationFile

Workbooks.Open Filename:="C:Thư mục của bạn Tên file.Định dạng"
 Windows("Tên file phía trên.Định dạng").Activate

'Windows("Tên file phía trên.Định dạng").Activate
 'ActiveWorkbook.Save
 '   ActiveWindow.Close

Windows(""Tên file .Định dạng"").Activate
Sheets("Tên sheet").Select
Range("A1").Select
 MsgBox " Đã cập nhật  !"

End Sub
Function getSpeed(doIt As Boolean)
Application.ScreenUpdating = Not (doIt)
Application.EnableEvents = Not (doIt)

End Function

Đoạn Code này có thể lấy Data từ File khác, kể cả Update lên One Driver…

hands says:

27/01/2023 at 9:06 am

Chào các anh chị, em có bắt chước code của anh @Hoàng Tuấn 868 để lấy dữ liệu, nhưng code của anh là lấy hết tất cả, ví dụ file em có sử dụng công thức, nếu chưa có dữ liệu thì sẽ hiên "Value" hoặc " N/A" mà code của anh @Hoàng Tuấn 868 lấy luôn các dong đó. Nên bây giờ em mong các anh chị giúp chỉnh code để lấy dữ liệu khi cột C (Date) có ngày tháng năm thì mới lấy. Em xin đưa file.

Bạn thử lại xem sao nhé.

Cám ơn anh @Hoàng Tuấn 868 nhiều ạ. Đúng rồi ạ.

Reply
hands says:

24/02/2023 at 2:17 pm

Có thể chỉnh code để có thể copy theo ngày được không anh @Hoàng Tuấn 868 ???
Ví dụ khi em chép tới ngày 10/02/2023 rồi, thì tiếp theo em chỉ chép tiếp ngày 11/02/2023 được không anh??

Lâu chưa xem lại nhưng có thể thêm điều kiện lấy ngày nào theo mình mong muốn thôi.
Bạn cho ví dụ cụ thể, diễn giải thao tác và kết quả mong muốn vào file xem thế nào. Ví dụ là nhập ngày nào thì lấy ngày đó thôi hay chỉ lấy ngày nhỏ hơn hoặc bằng ngày chọn chẳng hạn…
Không thì dùng thử file này xem đúng ý chưa nhé. (Nhập ngày nào lấy dữ liệu ngày đó).

À anh @Hoàng Tuấn 868 ơi, mới phát sinh ra một chổ này là khi cột A có Cell rỗng (tất nhiên cột C có ngày) thì code không lấy dữ liệu.
Ví dụ như Cell A1 tới A10 có dữ liệu, Cell A11 rỗng, Cell A12 tới A20 có dữ liệu (tất nhiên C1 tới C20 có ngày) thì code lấy dữ liệu tới A10 thôi, từ A11 tới A20 không lấy. Mong anh chỉnh code lấy luôn hết nếu cột C có ngày mà cột A có cell rỗng.

Reply
hands says:

12/03/2023 at 2:50 pm

Cám ơn anh @Hoàng Tuấn 868 nhiều!!!!
Sao em nhập ngày vào và nhấn OK chẳng thấy chép dữ liệu gì hết anh ơi.
Cách nhập là sao anh? Ví dụ chon ngày 25, thì nhâp số 25, hay nhập 25-nov-22, em đã thử hết cách nhập vẫn không được.
Mong anh chỉ giáo.
Ý em là nhập ngày nào thì lấy ngày lớn hơn và bằng ngày chọn.

Bạn nhập như sau: 08/11/2022 hoặc 08/11/22 đều được.
File này mình đặt lấy giá trị lớn hơn hoặc bằng ngày chọn.

Reply