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

Liên hệ QC

chidung2009

Thành viên hoạt động
Tham gia
12/9/12
Bài viết
123
Được thích
8
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



Mã:
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
 

File đính kèm

  • Lấy dữ liệu.zip
    178.3 KB · Đọc: 20
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
 

File đính kèm

  • Nguon data.xlsb
    61 KB · Đọc: 12
  • Them du lieu vao Sheet (Sửa Code).xlsb
    142.5 KB · Đọc: 11
Lần chỉnh sửa cuối:
Upvote 0
Nhờ vả mà chỉ đích danh như này có vẻ hơi lâu
Mình đi nhìe nhìu nên bít
Kkk
 
Upvote 0
Upvote 0
Do anh @Hoàng Tuấn 868 viết code nên sẽ hiểu rõ nhất. Nếu ai hiểu xin giúp mình với
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 ...
 
Upvote 0
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 ...
Bạn đã bắt đúng bệnh rồi. Cảm ơn bạn nhiều,
Nhân dịp xuân Quý Mão 2023 chúc bạn và gia đình GPE luôn mạnh khỏe, bình an...
 
Upvote 0
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è.

Mã:
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

Hổng dám đâu. Chuyến này bạn bứng được cây trâm bầu rồi.
Cái này nó gọi là thực chiến bác ạ. Sẽ phát sinh nhiều tình huống đây, không biết sẽ có bao nhiêu loại tổ hợp sheet nữa ấy.
 
Upvote 0
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
 
Upvote 0
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
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ả.

Screen Shot 2023-01-12 at 16.50.55.png

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.
Mã:
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.
 
Lần chỉnh sửa cuối:
Upvote 0
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ả.

View attachment 285690

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.
Mã:
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
 
Upvote 0
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.
 

File đính kèm

  • Them du lieu vao Sheet (ongke0711).xlsb
    134.7 KB · Đọc: 16
  • Nguon data.xlsx
    74.7 KB · Đọc: 12
Upvote 0
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.
Cám ơn anh,
Chắc chủ thớt mừng gớt nước mắt!
 
Upvote 0
Web KT
Back
Top Bottom