Giúp mình về dữ liệu lớn trong exel (3 người xem)

Liên hệ QC

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

vnlife2000

Thành viên chính thức
Tham gia
3/4/07
Bài viết
71
Được thích
0
Chào anh/chi, mình có dữ liệu lớn cần trích lọc nhưng vì file dữ liệu lớn quá có thể hơn 1.048.576 dòng nên mỗi lần mình dùng hàm vlookup để tra thì load rất là lâu, có cách nào dùng code tra và mở dữ liêu nhanh hơn không.
Một file dữ liệu gồm 2 cột : Mã số và tên
một file dùng để lọc mã số từ file dữ liệu đó
Cảm ơn anh/chi rất nhiều
 

File đính kèm

Lần chỉnh sửa cuối:
Chào anh/chi, mình có dữ liệu lớn cần trích lọc nhưng vì file dữ liệu lớn quá có thể hơn 1.048.576 dòng nên mỗi lần mình dùng hàm vlookup để tra thì load rất là lâu, có cách nào dùng code tra và mở dữ liêu nhanh hơn không.
Một file dữ liệu gồm 2 cột : Mã số và tên
một file dùng để lọc mã số từ file dữ liệu đó
Cảm ơn anh/chi rất nhiều
đặt 2 file trong cùng 1 thư mục
mở file PHIEU.XLSX Save As lại theo tên PHIEU.XLXB hoặc PHIEU.XLXM trong cùng thư mục
chep code sau vào và chạy thử xem sao
Mã:
Sub Vlookup()
Dim Dic As Object, Darr(), Arr(), i As Long, LastR As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'On Error Resume Next
Workbooks.Open Filename:=ThisWorkbook.Path & "\DULIEU.XLSX", ReadOnly:=True
With ActiveWorkbook.Sheets("NNT")
  LastR = .Range("A1040000").End(xlUp).Row
  If LastR < 4 Then
    MsgBox ("Khong co du lieu, thoat chuong trinh"): Exit Sub
  End If
  Darr = .Range("A4:B" & LastR).Value
End With
Set Dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(Darr)
  Dic.Add Darr(i, 1), Darr(i, 2)
Next i
ActiveWorkbook.Close False
LastR = Range("A1040000").End(xlUp).Row
If LastR < 4 Then
    MsgBox ("Khong co du lieu, thoat chuong trinh"): Exit Sub
End If
Darr = Range("A4:A" & LastR).Value
ReDim Arr(1 To UBound(Darr), 1 To 1)
For i = 1 To UBound(Arr)
  Arr(i, 1) = Dic.Item(Darr(i, 1))
Next i
Range("B4").Resize(UBound(Arr)) = Arr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 

File đính kèm

Cảm ơn bạn HiếuCD nhưng mình test dữ liệu lớn khoảng 1.040.000 dòng thì cũng rất lâu nhưng khi gặp lỗi kg tìm thấy là báo không có dữ liệu và thoát chương trình, có cách nào khắc phục không bạn? và mình có nhiều hơn số dòng 1.040.000 thì mình làm thêm cột thì mình phải tìm bằng cách nào bạn giúp mình với ạ.
(mình up lại file ở #1 ạ)
 
Cảm ơn bạn HiếuCD nhưng mình test dữ liệu lớn khoảng 1.040.000 dòng thì cũng rất lâu nhưng khi gặp lỗi kg tìm thấy là báo không có dữ liệu và thoát chương trình, có cách nào khắc phục không bạn? và mình có nhiều hơn số dòng 1.040.000 thì mình làm thêm cột thì mình phải tìm bằng cách nào bạn giúp mình với ạ.
(mình up lại file ở #1 ạ)
bạn tìm trong code số 1040000 thay bằng số 1048576 xem sao
nếu nhiều hơn thì gởi lại file với ví dụ các cột dữ liệu
 
bạn tìm trong code số 1040000 thay bằng số 1048576 xem sao
nếu nhiều hơn thì gởi lại file với ví dụ các cột dữ liệu
Viết vầy được không anh HieuCD

Mã:
lastR = .Range("A" & .Rows.Count).End(xlUp).Row
    If .Range("A" & Rows.Count) <> "" Then lastR = lastR + 1 'Phòng trường hợp dòng cuối có dữ liệu
 
Viết vầy được không anh HieuCD

Mã:
lastR = .Range("A" & .Rows.Count).End(xlUp).Row
    If .Range("A" & Rows.Count) <> "" Then lastR = lastR + 1 'Phòng trường hợp dòng cuối có dữ liệu
mình thử rồi, với dữ liệu của file bắt đầu bằng ô A3, nếu tới dòng cuối của sheet có dữ liệu thì kết quả cũng không chính xác
dùng code sau có vẽ ổn
Mã:
lastR = Range("A3").CurrentRegion.RowS.Count + 2
chúc bạn 1 tối vui
 
Chào anh/chi, mình có dữ liệu lớn cần trích lọc nhưng vì file dữ liệu lớn quá có thể hơn 1.048.576 dòng nên mỗi lần mình dùng hàm vlookup để tra thì load rất là lâu, có cách nào dùng code tra và mở dữ liêu nhanh hơn không.
Một file dữ liệu gồm 2 cột : Mã số và tên
một file dùng để lọc mã số từ file dữ liệu đó
Cảm ơn anh/chi rất nhiều
Code này viết trích lọc trên 1 file
Bạn nạp dữ liệu 1tr dòng thử xem thế nào
Mã:
Sub vnlife()
Dim Phieu, NTT, KQ, r, i
Phieu = Sheet1.Range("A4", Sheet1.Range("A4").End(xlDown))
ReDim KQ(1 To UBound(Phieu), 1 To 1)
NTT = Sheet2.Range("A4", Sheet2.Range("B4").End(xlDown))
With CreateObject("scripting.Dictionary")
For r = 1 To UBound(Phieu)
.Item(Phieu(r, 1)) = ""
Next r
For r = 1 To UBound(NTT)
If .exists(NTT(r, 1)) = True Then
i = i + 1
KQ(i, 1) = NTT(r, 2)
End If
Next r
End With
Sheet1.Range("A4", Sheet1.Range("A4").End(xlDown)).Offset(, 1).ClearContents
Sheet1.Range("A4", Sheet1.Range("A4").End(xlDown)).Offset(, 1) = KQ
End Sub
Ngoài ra, nếu làm trên 1 file thì có thể dùng advanced filter cũng giải quyết được vấn đề tốc độ.
 

File đính kèm

Mình đã gửi lại file đính kèm vlookup ở #1 đó bạn hiếu. Bạn xem giúp mình.
 
Mình đã gửi lại file đính kèm vlookup ở #1 đó bạn hiếu. Bạn xem giúp mình.
 
Mình đã gửi lại file đính kèm vlookup ở #1 đó bạn hiếu. Bạn xem giúp mình.
bạn chạy thử code, trong đó nếu dữ liệu nguồn nếu nhiều thì nhập tiếp vào cột D và E, cùng hàng đầu cột A và B
Mã:
Sub Vlookup()
Dim Dic As Object, Darr(), Arr(), i As Long, LastKQ As Long, LastNg As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'On Error Resume Next
LastKQ = Range("A3").CurrentRegion.Rows.Count + 2
If LastKQ < 4 Then
    MsgBox ("Khong co du lieu Ma de lay ten, thoat chuong trinh"): Exit Sub
End If
Set Dic = CreateObject("scripting.dictionary")
Workbooks.Open Filename:=ThisWorkbook.Path & "\DULIEU.XLSX", ReadOnly:=True
With ActiveWorkbook.Sheets("NNT")
  LastNg = .Range("A3").CurrentRegion.Rows.Count + 2
  If LastNg < 4 Then
    MsgBox ("Khong co du lieu nguon, thoat chuong trinh"): Exit Sub
  End If
  Darr = .Range("A4:B" & LastNg).Value
  For i = 1 To UBound(Darr)
    Dic.Add Darr(i, 1), Darr(i, 2)
  Next i
' du lieu nhieu, nhap them vao cot D va E
  LastNg = .Range("D3").CurrentRegion.Rows.Count + 2
  If LastNg >= 4 Then
    Darr = .Range("A4:B" & LastNg).Value
    For i = 1 To UBound(Darr)
      Dic.Add Darr(i, 1), Darr(i, 2)
    Next i
  End If
End With
ActiveWorkbook.Close False


Darr = Range("A4:A" & LastKQ).Value
ReDim Arr(1 To UBound(Darr), 1 To 1)
For i = 1 To UBound(Arr)
  Arr(i, 1) = Dic.Item(Darr(i, 1))
Next i
Range("B4").Resize(UBound(Arr)) = Arr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 

File đính kèm

bạn chạy thử code, trong đó nếu dữ liệu nguồn nếu nhiều thì nhập tiếp vào cột D và E, cùng hàng đầu cột A và B
Mã:
Sub Vlookup()
Dim Dic As Object, Darr(), Arr(), i As Long, LastKQ As Long, LastNg As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'On Error Resume Next
LastKQ = Range("A3").CurrentRegion.Rows.Count + 2
If LastKQ < 4 Then
    MsgBox ("Khong co du lieu Ma de lay ten, thoat chuong trinh"): Exit Sub
End If
Set Dic = CreateObject("scripting.dictionary")
Workbooks.Open Filename:=ThisWorkbook.Path & "\DULIEU.XLSX", ReadOnly:=True
With ActiveWorkbook.Sheets("NNT")
  LastNg = .Range("A3").CurrentRegion.Rows.Count + 2
  If LastNg < 4 Then
    MsgBox ("Khong co du lieu nguon, thoat chuong trinh"): Exit Sub
  End If
  Darr = .Range("A4:B" & LastNg).Value
  For i = 1 To UBound(Darr)
    Dic.Add Darr(i, 1), Darr(i, 2)
  Next i
' du lieu nhieu, nhap them vao cot D va E
  LastNg = .Range("D3").CurrentRegion.Rows.Count + 2
  If LastNg >= 4 Then
    Darr = .Range("A4:B" & LastNg).Value
    For i = 1 To UBound(Darr)
      Dic.Add Darr(i, 1), Darr(i, 2)
    Next i
  End If
End With
ActiveWorkbook.Close False


Darr = Range("A4:A" & LastKQ).Value
ReDim Arr(1 To UBound(Darr), 1 To 1)
For i = 1 To UBound(Arr)
  Arr(i, 1) = Dic.Item(Darr(i, 1))
Next i
Range("B4").Resize(UBound(Arr)) = Arr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Mình vừa test thử bằng cách bỏ dữ liệu và cột D và E thì báo lỗi run time 457. Bạn Hiếu kiểm tra giúp mình với và mình có thử nếu nhỡ file dữ liệu có trùng dữ liệu thì khi chạy nó cũng báo lỗi như trên, bạn có thể code thêm nếu có trùng dữ liệu tìm kiếm tức có 2 dòng Mã giống nhau thì vẫn cho ra kq 1 trong 2 cái và nếu như tìm không có mã thì vẫn view ra cột tên trong file Phiếu ( view câu "khong co"). Cảm ơn bạn Hiếu nhiều lắm.
 
Mình vừa test thử bằng cách bỏ dữ liệu và cột D và E thì báo lỗi run time 457. Bạn Hiếu kiểm tra giúp mình với và mình có thử nếu nhỡ file dữ liệu có trùng dữ liệu thì khi chạy nó cũng báo lỗi như trên, bạn có thể code thêm nếu có trùng dữ liệu tìm kiếm tức có 2 dòng Mã giống nhau thì vẫn cho ra kq 1 trong 2 cái và nếu như tìm không có mã thì vẫn view ra cột tên trong file Phiếu ( view câu "khong co"). Cảm ơn bạn Hiếu nhiều lắm.
bạn chỉnh lại code
lưu ý chổ màu đỏ chỉ chọn 1 trong 2 và giống nhau của cả 2 đoạn lệnh
Mã:
Sub Vlookup()
Dim Dic As Object, Darr(), Arr(), i As Long, LastKQ As Long, LastNg As Long, Tmp
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'On Error Resume Next
LastKQ = Range("A3").CurrentRegion.Rows.Count + 2
If LastKQ < 4 Then
    MsgBox ("Khong co du lieu Ma de lay ten, thoat chuong trinh"): Exit Sub
End If
Set Dic = CreateObject("scripting.dictionary")
Workbooks.Open Filename:=ThisWorkbook.Path & "\DULIEU.XLSX", ReadOnly:=True
With ActiveWorkbook.Sheets("NNT")
  LastNg = .Range("A3").CurrentRegion.Rows.Count + 2
  If LastNg < 4 Then
    MsgBox ("Khong co du lieu nguon, thoat chuong trinh"): Exit Sub
  End If
  Darr = .Range("A4:B" & LastNg).Value
  For i = 1 To UBound(Darr)
    Tmp = Darr(i, 1)
'Ban chon mot trong 2 cách lay giá tri dau hoac cuoi, o 2 dong lenh duoi
[COLOR=#ff0000]    If Not Dic.exists(Tmp) Then Dic.Add Tmp, Darr(i, 2) 'Lay giá tri dau[/COLOR]
[COLOR=#ff0000]    'Dic.Item(Tmp) = Darr(i, 2) 'Lay gia tri cuoi[/COLOR]
  Next i
' du lieu nhieu, nhap them vao cot D va E
  LastNg = .Range("D3").CurrentRegion.Rows.Count + 2
  If LastNg >= 4 Then
    Darr = .Range("D4:E" & LastNg).Value
    For i = 1 To UBound(Darr)
      Tmp = Darr(i, 1)
'Ban chon mot trong 2 cách lay giá tri o 2 dong lenh duoi
[COLOR=#ff0000]      If Not Dic.exists(Tmp) Then Dic.Add Tmp, Darr(i, 2) 'Lay giá tri dau[/COLOR]
[COLOR=#ff0000]      'Dic.Item(Tmp) = Darr(i, 2) 'Lay gia tri cuoi[/COLOR]
    Next i
  End If
End With
ActiveWorkbook.Close False


Darr = Range("A4:A" & LastKQ).Value
ReDim Arr(1 To UBound(Darr), 1 To 1)
For i = 1 To UBound(Arr)
  Tmp = Darr(i, 1)
  If Dic.exists(Tmp) Then
    Arr(i, 1) = Dic.Item(Darr(i, 1))
  Else
    Arr(i, 1) = "Khong Co"
  End If
Next i
Range("B4").Resize(UBound(Arr)) = Arr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
bạn chỉnh lại code
lưu ý chổ màu đỏ chỉ chọn 1 trong 2 và giống nhau của cả 2 đoạn lệnh
Mã:
Sub Vlookup()
Dim Dic As Object, Darr(), Arr(), i As Long, LastKQ As Long, LastNg As Long, Tmp
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'On Error Resume Next
LastKQ = Range("A3").CurrentRegion.Rows.Count + 2
If LastKQ < 4 Then
    MsgBox ("Khong co du lieu Ma de lay ten, thoat chuong trinh"): Exit Sub
End If
Set Dic = CreateObject("scripting.dictionary")
Workbooks.Open Filename:=ThisWorkbook.Path & "\DULIEU.XLSX", ReadOnly:=True
With ActiveWorkbook.Sheets("NNT")
  LastNg = .Range("A3").CurrentRegion.Rows.Count + 2
  If LastNg < 4 Then
    MsgBox ("Khong co du lieu nguon, thoat chuong trinh"): Exit Sub
  End If
  Darr = .Range("A4:B" & LastNg).Value
  For i = 1 To UBound(Darr)
    Tmp = Darr(i, 1)
'Ban chon mot trong 2 cách lay giá tri dau hoac cuoi, o 2 dong lenh duoi
[COLOR=#ff0000]    If Not Dic.exists(Tmp) Then Dic.Add Tmp, Darr(i, 2) 'Lay giá tri dau[/COLOR]
[COLOR=#ff0000]    'Dic.Item(Tmp) = Darr(i, 2) 'Lay gia tri cuoi[/COLOR]
  Next i
' du lieu nhieu, nhap them vao cot D va E
  LastNg = .Range("D3").CurrentRegion.Rows.Count + 2
  If LastNg >= 4 Then
    Darr = .Range("D4:E" & LastNg).Value
    For i = 1 To UBound(Darr)
      Tmp = Darr(i, 1)
'Ban chon mot trong 2 cách lay giá tri o 2 dong lenh duoi
[COLOR=#ff0000]      If Not Dic.exists(Tmp) Then Dic.Add Tmp, Darr(i, 2) 'Lay giá tri dau[/COLOR]
[COLOR=#ff0000]      'Dic.Item(Tmp) = Darr(i, 2) 'Lay gia tri cuoi[/COLOR]
    Next i
  End If
End With
ActiveWorkbook.Close False


Darr = Range("A4:A" & LastKQ).Value
ReDim Arr(1 To UBound(Darr), 1 To 1)
For i = 1 To UBound(Arr)
  Tmp = Darr(i, 1)
  If Dic.exists(Tmp) Then
    Arr(i, 1) = Dic.Item(Darr(i, 1))
  Else
    Arr(i, 1) = "Khong Co"
  End If
Next i
Range("B4").Resize(UBound(Arr)) = Arr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Cảm ơn bạn Hiếu, code bạn chạy ok nhưng khi chạy với nhiều dòng thì bấm run phải đợi gần 3 phút mới ra kết quả, bởi vậy nên khi chạy code cảm giác như đang bị "treo" exel, bạn Hiếu có thể code khi bấm chạy hiện thông báo đang thực hiện, vui lòng đợi, và có thể chạy thêm tiến trình phần trăm hoàn thành để mình biết khi tiến trình hoàn thành lệnh được không ạ. Cảm ơn bạn nhiều.
 
Cảm ơn bạn Hiếu, code bạn chạy ok nhưng khi chạy với nhiều dòng thì bấm run phải đợi gần 3 phút mới ra kết quả, bởi vậy nên khi chạy code cảm giác như đang bị "treo" exel, bạn Hiếu có thể code khi bấm chạy hiện thông báo đang thực hiện, vui lòng đợi, và có thể chạy thêm tiến trình phần trăm hoàn thành để mình biết khi tiến trình hoàn thành lệnh được không ạ. Cảm ơn bạn nhiều.
vụ % nầy mình không rành, chỉ hiện thông báo thôi
 

File đính kèm

Hiện thông báo cũng được bạn ạ. bạn giúp mình code với.
 
Cảm ơn bạn Hiếu, code bạn chạy ok nhưng khi chạy với nhiều dòng thì bấm run phải đợi gần 3 phút mới ra kết quả, bởi vậy nên khi chạy code cảm giác như đang bị "treo" exel, bạn Hiếu có thể code khi bấm chạy hiện thông báo đang thực hiện, vui lòng đợi, và có thể chạy thêm tiến trình phần trăm hoàn thành để mình biết khi tiến trình hoàn thành lệnh được không ạ. Cảm ơn bạn nhiều.

Thử code mới (vẫn dựa chính trên code của bác HieuCD, nên tên file và bố trí dữ liệu vẫn vậy) này với dữ liệu lớn xem có nhanh lên không

hiện file kèm để cả 2 code

code cũ - sao xanh - chạy cho thời gian ở C1
code mới - sao vàng - chạy cho thời gian ở D1

Bạn thử chạy xem có cải thiện tốc độ chút nào không ? có tới 3 phút không? so sánh xem

Sau đó nếu cần thì gắn % thêm sau
 

File đính kèm

Thử code mới (vẫn dựa chính trên code của bác HieuCD, nên tên file và bố trí dữ liệu vẫn vậy) này với dữ liệu lớn xem có nhanh lên không

hiện file kèm để cả 2 code

code cũ - sao xanh - chạy cho thời gian ở C1
code mới - sao vàng - chạy cho thời gian ở D1

Bạn thử chạy xem có cải thiện tốc độ chút nào không ? có tới 3 phút không? so sánh xem

Sau đó nếu cần thì gắn % thêm sau
Cảm ơn bạn winvista, mình vừa chạy code bạn và đúng là nhanh hơn đáng kể: 251s vs 23s. Bạn giúp mình gắn % với ạ. Cảm ơn bạn winvista và bạn Hiếu nhiều lắm.
 
Cảm ơn bạn winvista, mình vừa chạy code bạn và đúng là nhanh hơn đáng kể: 251s vs 23s. Bạn giúp mình gắn % với ạ. Cảm ơn bạn winvista và bạn Hiếu nhiều lắm.

Đã gắn ProgressBar % . Nó sẽ làm chậm chương trình đi 1 chút đó,

Nếu vẫn thích thì lấy cái file kèm này, nhưng tôi nghĩ 23s là đợi tốt
 

File đính kèm

Lần chỉnh sửa cuối:
Web KT

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

Back
Top Bottom