Giúp đỡ sửa VBA lấy dữ liệu từ file Excel khác đang đóng (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
C

chidung2009

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

Sắp xếp theo thời gian sắp xếp theo bầu chọn
ongke0711 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
chidung2009 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
À 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.

Screen Shot 2023-01-13 at 23.11.23.png

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".
 
Upvote 0
ongke0711 đã viết:
À 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.

View attachment 285719

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".
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn rất nhiều. Nhân dịp xuân Quý Mão Chúc gia đình bạn luôn mạnh khỏe an khang, gặt hái nhiều thành công...
 
Upvote 0
chidung2009 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Bạn thử nghiên cứu xem nhé. Đoạn Code này có thể lấy Data từ File khác, kể cả Update lên One Driver...

Sub STARTRP()
getSpeed (True)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
sSourceFile = "C:\Users\DBC\OneDrive\DATA\Tê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
 
Upvote 0
cuongeva đã viết:
Bạn thử nghiên cứu xem nhé. Đoạn Code này có thể lấy Data từ File khác, kể cả Update lên One Driver...

Sub STARTRP()
getSpeed (True)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
sSourceFile = "C:\Users\DBC\OneDrive\DATA\Tê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
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn nhiều. Chúc năm mới bình an, khoẻ mạnh luôn đến với bạn
 
Upvote 0
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.
 

File đính kèm

Upvote 0
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??
 
Upvote 0
Upvote 0
Mong anh giúp thêm điều kiện lấy ngày nữa ạ.
 
Upvote 0
NguyenthiH đã viết:
Mong anh giúp thêm điều kiện lấy ngày nữa ạ.
Nhấp chuột vào đây để mở rộng...
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 đó).
 

File đính kèm

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

File đính kèm

Upvote 0
Xin lỗi em chụp bằng điện thoại, em nghi lỗi này do file nguồn và file đích có tên sheet gần giống nhau, như ABC, ABEF, AB. Chút nữa em gửi file cho anh nhe.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

nguyenhoangtuananh9897
Hỏi về nơi tải danh sách xã huyện tỉnh chuẩn (1 người xem)
2 3
Trả lời
43
Đọc
3K
ongke0711
ongke0711
OrangeBee
Xin nhờ anh chị giúp đỡ về CommandButton Userform. (2 người xem)
Trả lời
2
Đọc
37
OrangeBee
OrangeBee
ptm0412
Hình ảnh sinh nhật GPE lần 19 tại HCM (4 người xem)
    • Yêu thích
Trả lời
0
Đọc
20
ptm0412
ptm0412
Nga1852k
lỗi excel không chèn được dòng và không xóa được dòng
Trả lời
0
Đọc
38
Nga1852k
Nga1852k
K
  • Question Question
Viết code cho file lấy dữ liệu in -out từ bảng chấm công
Trả lời
1
Đọc
96
yaaasoo01
Y
GPE-Trợ Lý
[ĐÀ NẴNG] ĐĂNG KÝ THAM DỰ SINH NHẬT GIAIPHAPEXCEL LẦN THỨ 19 NGÀY 13/07/2025 (1 người xem)
    • Thích
Trả lời
6
Đọc
352
nguyenhuong
nguyenhuong
vc_đi chơi
Cộng ngày từ sheet này sang sheet khác bị nhảy lung tung (1 người xem)
Trả lời
8
Đọc
136
vc_đi chơi
vc_đi chơi
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
17 18 19
Trả lời
369
Đọc
42K
zzklzz
Z
N
Tạo COM Add-In bằng Visual C++
Trả lời
0
Đọc
97
nguyendang95
N
N
Giãn dòng trong excel
Trả lời
0
Đọc
75
nguyenichky
N
Phan Thế Hiệp
Tìm ngày giờ kết thúc dự kiến
    • Thích
    • Yêu thích
Trả lời
17
Đọc
711
Phan Thế Hiệp
Phan Thế Hiệp
GPE-Trợ Lý
[HCM] ĐĂNG KÝ THAM DỰ SINH NHẬT GIAIPHAPEXCEL LẦN THỨ 19 NGÀY 06/07/2025
    • Thích
    • Yêu thích
Trả lời
14
Đọc
1K
PhanTuHuong
PhanTuHuong
N
  • Question Question
Hỗ trợ tiếng việt trong macro (1 người xem)
Trả lời
10
Đọc
342
ptm0412
ptm0412
T
Hướng dẫn kết hợp Drop List và Group PivotTable có điều kiện
Trả lời
7
Đọc
220
ptm0412
ptm0412
Limhachung
Lỗi không copy past excel
Trả lời
3
Đọc
94
vanle33
vanle33
V
Xử lý dữ liệu bị âm
Trả lời
9
Đọc
294
HieuCD
H
Nguyễn Duy Tuân
  • Dán lên cao
Phiên bản mới Add-in A-Tools AI v10 (2024)
    • Thích
2 3
Trả lời
57
Đọc
7K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
N
gộp sheet có chứa hình ảnh
Trả lời
1
Đọc
105
thuytrangbp28
T
OverAC
  • Dán lên cao
  • Suggestion Suggestion
Chúc mừng sinh nhật GiaiPhapExcel 19 tuổi và tặng ebook "Lập trình VBA phần cơ bản."
    • Thích
    • Yêu thích
Trả lời
3
Đọc
896
PhanTuHuong
PhanTuHuong
nguyenthidao2906
cách gộp nhiều file về 1 file trong google sheet
Trả lời
5
Đọc
1K
nguyen thao1712
N
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Sinh nhật lần 19 GPE

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom