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

Liên hệ QC

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

chạy code nầy xem sao? không được là bỏ của chạy lấy người
Mã:
Sub Vlookup()
Dim Darr(), Sarr(), Arr(), Dic As Object, i As Long, RKQ As Long, R As Long, C As Integer, Tmp As String
'Sheets("Phieu").Shapes("Rounded Rectangle 1").Visible = True
Application.DisplayAlerts = False
Application.ScreenUpdating = False
RKQ = Range("A3").CurrentRegion.Rows.Count - 1
If RKQ < 4 Then
    MsgBox ("Khong co du lieu Ma de lay ten, thoat chuong trinh"): Exit Sub
End If
Set Dic = CreateObject("scripting.dictionary")
Sarr = Range("A4").Resize(RKQ).Value
ReDim Arr(1 To RKQ, 1 To 1)
For i = 1 To RKQ
  Tmp = Sarr(i, 1)
  If Not Dic.exists(Tmp) Then
    Dic.Add Tmp, 1
    Dic.Add Tmp & "#" & 1, i
  Else
    k = Dic.Item(Tmp) + 1
    Dic.Item(Tmp) = k
    Dic.Add Tmp & "#" & k, i
  End If
Next i


Workbooks.Open Filename:=ThisWorkbook.Path & "\DULIEU.XLSX", ReadOnly:=True
With ActiveWorkbook.Sheets("NNT")
  C = .Range("XX4").End(xlToLeft).Column
  R = .Range("A3").CurrentRegion.Rows.Count - 1
  Darr = .Range("A4").Resize(R, C).Value
End With
ActiveWorkbook.Close False
For j = 1 To C Step 3
  For i = 1 To R
    Tmp = Darr(i, j)
    If Tmp = "" Then Exit For
    If Dic.exists(Tmp) Then
      For k = 1 To Dic.Item(Tmp)
        n = n + 1
        Arr(Dic.Item(Darr(i, j) & "#" & k), 1) = Darr(i, j + 1)
      Next k
      If n = RKQ Then GoTo Thoat
    End If
  Next i
Next j
Thoat:
Range("B4").Resize(RKQ) = Arr
'Sheets("Phieu").Shapes("Rounded Rectangle 1").Visible = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Code này đổi thuật toán --> cho phép tốc độ cải thiện đáng kể.
 
Cảm ơn bạn Hiếu code chạy nhanh hơn rất nhiều.
chạy code nầy xem sao? không được là bỏ của chạy lấy người
Mã:
Sub Vlookup()
Dim Darr(), Sarr(), Arr(), Dic As Object, i As Long, RKQ As Long, R As Long, C As Integer, Tmp As String
'Sheets("Phieu").Shapes("Rounded Rectangle 1").Visible = True
Application.DisplayAlerts = False
Application.ScreenUpdating = False
RKQ = Range("A3").CurrentRegion.Rows.Count - 1
If RKQ < 4 Then
    MsgBox ("Khong co du lieu Ma de lay ten, thoat chuong trinh"): Exit Sub
End If
Set Dic = CreateObject("scripting.dictionary")
Sarr = Range("A4").Resize(RKQ).Value
ReDim Arr(1 To RKQ, 1 To 1)
For i = 1 To RKQ
  Tmp = Sarr(i, 1)
  If Not Dic.exists(Tmp) Then
    Dic.Add Tmp, 1
    Dic.Add Tmp & "#" & 1, i
  Else
    k = Dic.Item(Tmp) + 1
    Dic.Item(Tmp) = k
    Dic.Add Tmp & "#" & k, i
  End If
Next i


Workbooks.Open Filename:=ThisWorkbook.Path & "\DULIEU.XLSX", ReadOnly:=True
With ActiveWorkbook.Sheets("NNT")
  C = .Range("XX4").End(xlToLeft).Column
  R = .Range("A3").CurrentRegion.Rows.Count - 1
  Darr = .Range("A4").Resize(R, C).Value
End With
ActiveWorkbook.Close False
For j = 1 To C Step 3
  For i = 1 To R
    Tmp = Darr(i, j)
    If Tmp = "" Then Exit For
    If Dic.exists(Tmp) Then
      For k = 1 To Dic.Item(Tmp)
        n = n + 1
        Arr(Dic.Item(Darr(i, j) & "#" & k), 1) = Darr(i, j + 1)
      Next k
      If n = RKQ Then GoTo Thoat
    End If
  Next i
Next j
Thoat:
Range("B4").Resize(RKQ) = Arr
'Sheets("Phieu").Shapes("Rounded Rectangle 1").Visible = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Bạn kiểm tra lại giúp mình, nếu như gặp trường hợp tra mã bên data bị bỏ trống một ô thì kết quả kiểm tra nhảy sai và rất nhiều mã không cho ra kết quả. Cam on ban.
 
Bạn kiểm tra lại giúp mình, nếu như gặp trường hợp tra mã bên data bị bỏ trống một ô thì kết quả kiểm tra nhảy sai và rất nhiều mã không cho ra kết quả. Cam on ban.

"Bạn"=? là ai?
Data là ở file DULIEU? hay ở đâu?
Hỏi ai, bài nào code nào thì cần trích dẫn lại.

Chữ đỏ cần viết thận trọng nhất thì lại qua loa, đúng là cám dành cho heo và ơn ... dành cho ....
 
Lần chỉnh sửa cuối:
Bạn winvista và bạn hiếu. DATA là file dữ liệu bạn, vài ngày nay mình ktra chạy đúng, nhưng với điều kiện là cột mã file dữ liệu kg bị trống một ô nào đó, này mình tạm khắc phục bằng cách kiểm tra lại có cột nào trống kg mình thêm vào, nhưng hôm nay mình vừa phát hiện ra là nếu mình gõ bằng tay vào cột mã file dulieu thì code của winvista kg tìm thấy nhưng code bạn hiếu lại tìm thấy và đúng. còn code bạn hiếu thì mỗi lần tìm kiếm xong dòng cuối cùng nó lại thêm vài dòng ở dưới cho dù dòng đó kg có mã để dò.
"Bạn"=? là ai?
Data là ở file DULIEU? hay ở đâu?
Hỏi ai, bài nào code nào thì cần trích dẫn lại.

Chữ đỏ cần viết thận trọng nhất thì lại qua loa, đúng là cám dành cho heo và ơn ... dành cho ....
 
Bạn winvista và bạn hiếu. DATA là file dữ liệu bạn, vài ngày nay mình ktra chạy đúng, nhưng với điều kiện là cột mã file dữ liệu kg bị trống một ô nào đó, này mình tạm khắc phục bằng cách kiểm tra lại có cột nào trống kg mình thêm vào, nhưng hôm nay mình vừa phát hiện ra là nếu mình gõ bằng tay vào cột mã file dulieu thì code của winvista kg tìm thấy nhưng code bạn hiếu lại tìm thấy và đúng. còn code bạn hiếu thì mỗi lần tìm kiếm xong dòng cuối cùng nó lại thêm vài dòng ở dưới cho dù dòng đó kg có mã để dò.

Không hiểu bạn nói gì. Nếu trống đã điền vào thì sẽ có kết quả như ý
tại sao Data ở DULIEU lại không liên tục, lại có dòng trống vậy?
 
Trống do lỗi nhập liệu từ ứng dụng, nhưng lỗi trống mình đã nhập vào rồi nhưng code bạn vẫn phát sinh lỗi nếu như trong mã file PHIEU, nếu nhập tay vào thì dòng mã đó tìm kg ra, cho kết quả trống. bạn xem giúp mình.
Không hiểu bạn nói gì. Nếu trống đã điền vào thì sẽ có kết quả như ý
tại sao Data ở DULIEU lại không liên tục, lại có dòng trống vậy?
 
Trống do lỗi nhập liệu từ ứng dụng, nhưng lỗi trống mình đã nhập vào rồi nhưng code bạn vẫn phát sinh lỗi nếu như trong mã file PHIEU, nếu nhập tay vào thì dòng mã đó tìm kg ra, cho kết quả trống. bạn xem giúp mình.

Bạn kiệm lời quá, muốn giúp cũng khó.

+ gõ tay ở file "Phieu.." bạn phải lưu ý là mã là dạng text có số 0 ở đâu, nên khi gõ phải thêm dấu nháy trên ví dụ: '0100100061
vì không có excel sẽ hiểu là number và bỏ số 0 ===> không trùng mã nào nên kết quả trống

+ lần sau bạn nên nói chi tiết, hình ảnh, file số liệu kèm đê minh họa, không có sao mà hiểu
 
Mình gõ số không có số 0 ở đầu bạn ah mà nó tìm cũng kg ra luôn.
Bạn kiệm lời quá, muốn giúp cũng khó.

+ gõ tay ở file "Phieu.." bạn phải lưu ý là mã là dạng text có số 0 ở đâu, nên khi gõ phải thêm dấu nháy trên ví dụ: '0100100061
vì không có excel sẽ hiểu là number và bỏ số 0 ===> không trùng mã nào nên kết quả trống

+ lần sau bạn nên nói chi tiết, hình ảnh, file số liệu kèm đê minh họa, không có sao mà hiểu
 
Bạn winvista và bạn hiếu. DATA là file dữ liệu bạn, vài ngày nay mình ktra chạy đúng, nhưng với điều kiện là cột mã file dữ liệu kg bị trống một ô nào đó, này mình tạm khắc phục bằng cách kiểm tra lại có cột nào trống kg mình thêm vào, nhưng hôm nay mình vừa phát hiện ra là nếu mình gõ bằng tay vào cột mã file dulieu thì code của winvista kg tìm thấy nhưng code bạn hiếu lại tìm thấy và đúng. còn code bạn hiếu thì mỗi lần tìm kiếm xong dòng cuối cùng nó lại thêm vài dòng ở dưới cho dù dòng đó kg có mã để dò.
thêm vài dòng đưới có lẽ bạn nhập thêm ở dòng 1 và 2 dữ liệu gì đó
bạn chạy lại code đã điều chỉnh dòng và có thể tăng thêm tốc độ xử lý
Mã:
Sub Vlookup()
Dim Darr(), Sarr(), Arr(), R(), Dic As Object, i As Long, RKQ As Long
Dim C As Integer, j As Integer, k As Integer, Tmp As String
'Sheets("Phieu").Shapes("Rounded Rectangle 1").Visible = True
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If Range("A1048576") <> "" Then
  RKQ = 1048576 - 3
Else
  RKQ = Range("A1048576").End(xlUp).Row - 3
End If
If RKQ < 4 Then
    MsgBox ("Khong co du lieu Ma de lay ten, thoat chuong trinh"): Exit Sub
End If
Set Dic = CreateObject("scripting.dictionary")
Sarr = Range("A4").Resize(RKQ).Value
ReDim Arr(1 To RKQ, 1 To 1)
For i = 1 To RKQ
  Tmp = Sarr(i, 1)
  If Tmp <> "" Then
    If Not Dic.exists(Tmp) Then
      Dic.Add Tmp, 1
      Dic.Add Tmp & "#" & 1, i
    Else
      k = Dic.Item(Tmp) + 1
      Dic.Item(Tmp) = k
      Dic.Add Tmp & "#" & k, i
    End If
  End If
Next i


Workbooks.Open Filename:=ThisWorkbook.Path & "\DULIEU.XLSX", ReadOnly:=True
With ActiveWorkbook.Sheets("NNT")
  C = .Range("XX4").End(xlToLeft).Column
  ReDim R(1 To C)
  For j = 1 To C Step 3
    If .Cells(1048576, j) <> "" Then
      R(j) = 1048576 - 3
    Else
      R(j) = .Cells(1048576, j).End(xlUp).Row - 3
    End If
  Next j
  Darr = .Range("A4").Resize(R(1), C).Value
End With
ActiveWorkbook.Close False
For j = 1 To C Step 3
  For i = 1 To R(j)
    Tmp = Darr(i, j)
    If Dic.exists(Tmp) Then
      For k = 1 To Dic.Item(Tmp)
        n = n + 1
        Arr(Dic.Item(Darr(i, j) & "#" & k), 1) = Darr(i, j + 1)
      Next k
      Dic.Remove (Tmp)
      If n = RKQ Then GoTo Thoat
    End If
  Next i
Next j
Thoat:
Range("B4").Resize(RKQ) = Arr
'Sheets("Phieu").Shapes("Rounded Rectangle 1").Visible = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Mình vừa test code hiện tại chạy đúng chưa thấy lỗi. cảm ơn bạn Hiếu

Mình vừa test code hiện tại chạy đúng chưa thấy lỗi. cảm ơn bạn Hiếu
thêm vài dòng đưới có lẽ bạn nhập thêm ở dòng 1 và 2 dữ liệu gì đó
bạn chạy lại code đã điều chỉnh dòng và có thể tăng thêm tốc độ xử lý
Mã:
Sub Vlookup()
Dim Darr(), Sarr(), Arr(), R(), Dic As Object, i As Long, RKQ As Long
Dim C As Integer, j As Integer, k As Integer, Tmp As String
'Sheets("Phieu").Shapes("Rounded Rectangle 1").Visible = True
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If Range("A1048576") <> "" Then
  RKQ = 1048576 - 3
Else
  RKQ = Range("A1048576").End(xlUp).Row - 3
End If
If RKQ < 4 Then
    MsgBox ("Khong co du lieu Ma de lay ten, thoat chuong trinh"): Exit Sub
End If
Set Dic = CreateObject("scripting.dictionary")
Sarr = Range("A4").Resize(RKQ).Value
ReDim Arr(1 To RKQ, 1 To 1)
For i = 1 To RKQ
  Tmp = Sarr(i, 1)
  If Tmp <> "" Then
    If Not Dic.exists(Tmp) Then
      Dic.Add Tmp, 1
      Dic.Add Tmp & "#" & 1, i
    Else
      k = Dic.Item(Tmp) + 1
      Dic.Item(Tmp) = k
      Dic.Add Tmp & "#" & k, i
    End If
  End If
Next i


Workbooks.Open Filename:=ThisWorkbook.Path & "\DULIEU.XLSX", ReadOnly:=True
With ActiveWorkbook.Sheets("NNT")
  C = .Range("XX4").End(xlToLeft).Column
  ReDim R(1 To C)
  For j = 1 To C Step 3
    If .Cells(1048576, j) <> "" Then
      R(j) = 1048576 - 3
    Else
      R(j) = .Cells(1048576, j).End(xlUp).Row - 3
    End If
  Next j
  Darr = .Range("A4").Resize(R(1), C).Value
End With
ActiveWorkbook.Close False
For j = 1 To C Step 3
  For i = 1 To R(j)
    Tmp = Darr(i, j)
    If Dic.exists(Tmp) Then
      For k = 1 To Dic.Item(Tmp)
        n = n + 1
        Arr(Dic.Item(Darr(i, j) & "#" & k), 1) = Darr(i, j + 1)
      Next k
      Dic.Remove (Tmp)
      If n = RKQ Then GoTo Thoat
    End If
  Next i
Next j
Thoat:
Range("B4").Resize(RKQ) = Arr
'Sheets("Phieu").Shapes("Rounded Rectangle 1").Visible = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Bạn xem lại code giúp mình, nếu bị trường hợp gặp một dòng trống trong file phieu thì nó dừng kg chạy nữa. và nếu gõ mã vào có khi nó tìm được có khi kg tìm đc bạn ah, mình gõ kg có số 0 ở trước. Và trước khi tìm thì xóa dữ liệu dò trước đó đi. Cảm ơn bạn
Không hiểu bạn nói gì. Nếu trống đã điền vào thì sẽ có kết quả như ý
tại sao Data ở DULIEU lại không liên tục, lại có dòng trống vậy?
 
Lần chỉnh sửa cuối:
Bạn xem lại code giúp mình, nếu bị trường hợp gặp một dòng trống trong file phieu thì nó dừng kg chạy nữa. và nếu gõ mã vào có khi nó tìm được có khi kg tìm đc bạn ah, mình gõ kg có số 0 ở trước. Và trước khi tìm thì xóa dữ liệu dò trước đó đi. Cảm ơn bạn

* Chú ý dòng đỏ sau
Bạn kiệm lời quá, muốn giúp cũng khó.

+ gõ tay ở file "Phieu.." bạn phải lưu ý là mã là dạng text có số 0 ở đâu, nên khi gõ phải thêm dấu nháy trên ví dụ: '0100100061
vì không có excel sẽ hiểu là number và bỏ số 0 ===> không trùng mã nào nên kết quả trống

+ lần sau bạn nên nói chi tiết, hình ảnh, file số liệu kèm đê minh họa, không có sao mà hiểu
muốn có kết quả tra được thì mã ở PHIEU phải giống mã bên DULIEU, không giống thì tất nhiên không có kết quả

* Không hiểu câu màu xanh này là sao?
Bạn xem lại code giúp mình, nếu bị trường hợp gặp một dòng trống trong file phieu thì nó dừng kg chạy nữa. và nếu gõ mã vào có khi nó tìm được có khi kg tìm đc bạn ah, mình gõ kg có số 0 ở trước. Và trước khi tìm thì xóa dữ liệu dò trước đó đi. Cảm ơn bạn


* Có code trên của HieuCD (code này đã cải thiện tốc đô rùi) chưa thỏa mãn yêu cầu của bạn sao? Nếu rui cần chi code nữa
 
Lần chỉnh sửa cuối:
Mình biết vấn để số 0 ở trước cho nên nếu như mình muốn test số 0 thì thêm dấu nháy ' roi, nhưng vấn đề mình hỏi là mình gõ và tìm số không có số '0 trước vẫn kg tìm ra kết quả nhưng cũng có trường hợp mình gõ vào lại tìm được kq, chính vì vậy nên mình test đủ kiểu để cho ra kq đúng như ý, và cũng vì muốn đc kết quả chính xác nên mình phải dùng cả 2 code chạy và so kq chứ mỗi lần chạy kq cả hơn 5000 dòng kg ktra hết đc bạn ah.
* Chú ý dòng đỏ sau

muốn có kết quả tra được thì mã ở PHIEU phải giống mã bên DULIEU, không giống thì tất nhiên không có kết quả

* Không hiểu câu màu xanh này là sao?



* Có code trên của HieuCD (code này đã cải thiện tốc đô rùi) chưa thỏa mãn yêu cầu của bạn sao? Nếu rui cần chi code nữa
 
Mình biết vấn để số 0 ở trước cho nên nếu như mình muốn test số 0 thì thêm dấu nháy ' roi, nhưng vấn đề mình hỏi là mình gõ và tìm số không có số '0 trước vẫn kg tìm ra kết quả nhưng cũng có trường hợp mình gõ vào lại tìm được kq, chính vì vậy nên mình test đủ kiểu để cho ra kq đúng như ý, và cũng vì muốn đc kết quả chính xác nên mình phải dùng cả 2 code chạy và so kq chứ mỗi lần chạy kq cả hơn 5000 dòng kg ktra hết đc bạn ah.

Rất tiếc , bạn nói không có file minh họa nên tôi chỉ biết phán thôi, tóm lại bạn phải nhập mã giống hệt mã trong DULIEU thì mới có kết quả
 
Trả về khổ chủ

đầy đủ cả
+ dòng trống ở cả DULIEU, và PHIEU
+ xet số 0 hay không số 0 (nếu bỏ tích chọn cái này, thì chương trình chạy nhanh hơn chút)
vv
 

File đính kèm

Lần chỉnh sửa cuối:
Bạn xem file này, mình gõ nhưng có mã thì tra ra, mã kg tra ra
http://www.mediafire.com/file/qmidu80ao7d97ib/Vloopup_error+go.rar

2 mã này
[TABLE="width: 142"]
[TR]
[TD]2300109989[/TD]
[/TR]
[TR]
[TD]2400112537[/TD]
[/TR]
[/TABLE]
có trong FILE dữ liệu đâu mà có kết quả??? bạn phải tự search xem trong DULIEU có hay không thì mới đúng

thử gõ
[TABLE="width: 142"]
[TR]
[TD="class: xl66, width: 142, align: right"]2016131277[/TD]
[/TR]
[/TABLE]

sẽ có kết quả
 
2 file mới đây bạn ơi và mình phát hiện ra rằng nếu như file dữ liệu mình gõ và file phiếu mình gõ sẽ ra kq đúng, còn nếu như file dữ liệu mình copy nhưng file phiếu mình gõ sẽ kg ra kq.
http://www.mediafire.com/file/82cccgtacjt1m2w/go+loi.rar
2 mã này
[TABLE="width: 142"]
[TR]
[TD]2300109989[/TD]
[/TR]
[TR]
[TD]2400112537[/TD]
[/TR]
[/TABLE]
có trong FILE dữ liệu đâu mà có kết quả??? bạn phải tự search xem trong DULIEU có hay không thì mới đúng

thử gõ
[TABLE="width: 142"]
[TR]
[TD="class: xl66, width: 142, align: right"]2016131277[/TD]
[/TR]
[/TABLE]

sẽ có kết quả
 
Thử cái mới này xem có khác biệt gì không

báo lại nhé,

dĩ nhiên mã không có thì sẽ không có
 

File đính kèm

Web KT

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

Back
Top Bottom