Dò tìm chính xác tuyệt đối

tangoctuan · 18/10/19

Nhờ các Pro viết giúp 1 đoạn VBA để dò tìm giá trị chính xác tuyệt đối. Với điều kiện:

Chỉ trả kết quả dò tìm của các giá trị ở cột 3 vào cột KQ - khi giá trị ở cột 4 là 1.
Nếu giá trị cột 4 khác 1 thì không thay đổi giá trị tương ứng có sẵn ở cột KQ. (tức là code chỉ tác động vào cột KQ với những dòng có con 1 ở cột 4).
Dò tìm với điều kiện chính xác tuyệt đối, phân biệt cả hoa/thường hay không dấu/có dấu.

Dữ liệu có thể lên tới 500k dòng nên dùng hàm thông thường không chạy nổi.
Mình có gửi theo kèm file nhờ các bạn hỗ trợ giúp.

HieuCD · 18/10/19

tangoctuan đã viết:
Nhờ các Pro viết giúp 1 đoạn VBA để dò tìm giá trị chính xác tuyệt đối. Với điều kiện:

Chỉ trả kết quả dò tìm của các giá trị ở cột 3 vào cột KQ - khi giá trị ở cột 4 là 1.

Nếu giá trị cột 4 khác 1 thì không thay đổi giá trị tương ứng có sẵn ở cột KQ. (tức là code chỉ tác động vào cột KQ với những dòng có con 1 ở cột 4).

Dò tìm với điều kiện chính xác tuyệt đối, phân biệt cả hoa/thường hay không dấu/có dấu.

Dữ liệu có thể lên tới 500k dòng nên dùng hàm thông thường không chạy nổi.
Mình có gửi theo kèm file nhờ các bạn hỗ trợ giúp.
View attachment 226848

Mã:

Sub DoTim()
  Dim sArr(), dArr(), Res()
  Dim eR1&, eR2&, i&, sRow&
  With Sheet1
    eR1 = .Range("A" & Rows.Count).End(xlUp).Row
    eR2 = .Range("D" & Rows.Count).End(xlUp).Row
    If eR1 < 3 Or eR2 < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A3:B" & eR1).Value
    dArr = .Range("D3:E" & eR2).Value
    Res = .Range("F3:F" & eR2).Value
  End With
  With CreateObject("scripting.dictionary")
    sRow = UBound(sArr)
    For i = 1 To sRow
      .Item(sArr(i, 1)) = sArr(i, 2)
    Next i
    sRow = UBound(dArr)
    For i = 1 To sRow
      If dArr(i, 2) = 1 Then
        Res(i, 1) = .Item(dArr(i, 1))
      End If
    Next i
  End With
  Sheet1.Range("F3").Resize(sRow).Value = Res
End Sub

leonguyenz · 18/10/19

tangoctuan đã viết:
Nhờ các Pro viết giúp 1 đoạn VBA để dò tìm giá trị chính xác tuyệt đối. Với điều kiện:

Chỉ trả kết quả dò tìm của các giá trị ở cột 3 vào cột KQ - khi giá trị ở cột 4 là 1.

Nếu giá trị cột 4 khác 1 thì không thay đổi giá trị tương ứng có sẵn ở cột KQ. (tức là code chỉ tác động vào cột KQ với những dòng có con 1 ở cột 4).

Dò tìm với điều kiện chính xác tuyệt đối, phân biệt cả hoa/thường hay không dấu/có dấu.

Dữ liệu có thể lên tới 500k dòng nên dùng hàm thông thường không chạy nổi.
Mình có gửi theo kèm file nhờ các bạn hỗ trợ giúp.
View attachment 226848

Code tương tự bài #2 của bác @HieuCD , chỉ viết khác 1 chút.

Mã:

Sub DoTim()
Dim dAr As Variant, sAr As Variant, i As Long
Dim Dic As Object, rAr As Variant
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    dAr = Range("A3:B" & Range("A3").End(xlDown).Row).Value2
    For i = 1 To UBound(dAr, 1)
        If Not Dic.Exists(dAr(i, 1)) Then
            Dic.Add dAr(i, 1), Array(dAr(i, 2))
        End If
    Next i
    
    sAr = Range("D3:F" & Range("D3").End(xlDown).Row).Value2
    ReDim rAr(1 To UBound(sAr, 1), 1 To 1)
    For i = 1 To UBound(sAr, 1)
        rAr(i, 1) = sAr(i, 3)
        If sAr(i, 2) = 1 And Dic.Exists(sAr(i, 1)) Then
            rAr(i, 1) = Dic.Item(sAr(i, 1))(0)
        End If
    Next i
    Range("G3").Resize(UBound(sAr, 1)) = rAr
End With
Set Dic = Nothing
End Sub

HieuCD · 18/10/19

leonguyenz đã viết:

Code tương tự bài #2 của bác @HieuCD , chỉ viết khác 1 chút.

Mã:

Sub DoTim()
Dim dAr As Variant, sAr As Variant, i As Long
Dim Dic As Object, rAr As Variant
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    dAr = Range("A3:B" & Range("A3").End(xlDown).Row).Value2
    For i = 1 To UBound(dAr, 1)
        If Not Dic.Exists(dAr(i, 1)) Then
            Dic.Add dAr(i, 1), Array(dAr(i, 2))
        End If
    Next i
   
    sAr = Range("D3:F" & Range("D3").End(xlDown).Row).Value2
    ReDim rAr(1 To UBound(sAr, 1), 1 To 1)
    For i = 1 To UBound(sAr, 1)
        rAr(i, 1) = sAr(i, 3)
        If sAr(i, 2) = 1 And Dic.Exists(sAr(i, 1)) Then
            rAr(i, 1) = Dic.Item(sAr(i, 1))(0)
        End If
    Next i
    Range("G3").Resize(UBound(sAr, 1)) = rAr
End With
Set Dic = Nothing
End Sub

Nếu ô D3 = IBI0082Yzzzz
Kết quả 2 code sẽ khác nhau

ppc0312 · 18/10/19

tangoctuan đã viết:
Nhờ các Pro viết giúp 1 đoạn VBA để dò tìm giá trị chính xác tuyệt đối. Với điều kiện:

Chỉ trả kết quả dò tìm của các giá trị ở cột 3 vào cột KQ - khi giá trị ở cột 4 là 1.

Nếu giá trị cột 4 khác 1 thì không thay đổi giá trị tương ứng có sẵn ở cột KQ. (tức là code chỉ tác động vào cột KQ với những dòng có con 1 ở cột 4).

Dò tìm với điều kiện chính xác tuyệt đối, phân biệt cả hoa/thường hay không dấu/có dấu.

Dữ liệu có thể lên tới 500k dòng nên dùng hàm thông thường không chạy nổi.
Mình có gửi theo kèm file nhờ các bạn hỗ trợ giúp.
View attachment 226848

500 dòng thì công thức dùng tốt

tangoctuan · 19/10/19

leonguyenz đã viết:
Code tương tự bài #2 của bác @HieuCD , chỉ viết khác 1 chút.

Bài đã được tự động gộp: 19/10/19

ppc0312 đã viết:
500 dòng thì công thức dùng tốt

500.000 bạn.

Bài đã được tự động gộp: 19/10/19

HieuCD đã viết:

Mã:

Sub DoTim()
  Dim sArr(), dArr(), Res()
  Dim eR1&, eR2&, i&, sRow&
  With Sheet1
    eR1 = .Range("A" & Rows.Count).End(xlUp).Row
    eR2 = .Range("D" & Rows.Count).End(xlUp).Row
    If eR1 < 3 Or eR2 < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A3:B" & eR1).Value
    dArr = .Range("D3:E" & eR2).Value
    Res = .Range("F3:F" & eR2).Value
  End With
  With CreateObject("scripting.dictionary")
    sRow = UBound(sArr)
    For i = 1 To sRow
      .Item(sArr(i, 1)) = sArr(i, 2)
    Next i
    sRow = UBound(dArr)
    For i = 1 To sRow
      If dArr(i, 2) = 1 Then
        Res(i, 1) = .Item(dArr(i, 1))
      End If
    Next i
  End With
  Sheet1.Range("F3").Resize(sRow).Value = Res
End Sub

Code chạy đúng ý mình. Một lần nữa cảm ơn các bác rất nhiều!

VetMini · 19/10/19

ppc0312 đã viết:
500 dòng thì công thức dùng tốt

Bạn là người từ hành tinh khác?

Ở GPE này chỉ có chuyện 5000 dòng thiết kế thành 500.000 . Chứ không bao giờ có chuyện thu gọn lại thành 500.
Tôn chỉ là "càng bự càng dễ nói chuyện với người khác"

tangoctuan · 19/10/19

HieuCD đã viết:

Mã:

Sub DoTim()
  Dim sArr(), dArr(), Res()
  Dim eR1&, eR2&, i&, sRow&
  With Sheet1
    eR1 = .Range("A" & Rows.Count).End(xlUp).Row
    eR2 = .Range("D" & Rows.Count).End(xlUp).Row
    If eR1 < 3 Or eR2 < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A3:B" & eR1).Value
    dArr = .Range("D3:E" & eR2).Value
    Res = .Range("F3:F" & eR2).Value
  End With
  With CreateObject("scripting.dictionary")
    sRow = UBound(sArr)
    For i = 1 To sRow
      .Item(sArr(i, 1)) = sArr(i, 2)
    Next i
    sRow = UBound(dArr)
    For i = 1 To sRow
      If dArr(i, 2) = 1 Then
        Res(i, 1) = .Item(dArr(i, 1))
      End If
    Next i
  End With
  Sheet1.Range("F3").Resize(sRow).Value = Res
End Sub

Nhờ bạn Hiếu xem giúp có cách nào code lại để có thể chạy nhanh hơn được nữa không nhỉ? Với dữ liệu trong file mình gửi kèm thì máy mình quay suốt chạy không nổi.

ppc0312 · 19/10/19

VetMini đã viết:
Bạn là người từ hành tinh khác?
Ở GPE này chỉ có chuyện 5000 dòng thiết kế thành 500.000 . Chứ không bao giờ có chuyện thu gọn lại thành 500.
Tôn chỉ là "càng bự càng dễ nói chuyện với người khác"

Không rõ, không hành tinh nào cả, vì nhìn có hành tình nào 500k thành 500 000

ppc0312 · 19/10/19

tangoctuan đã viết:
Nhờ bạn Hiếu xem giúp có cách nào code lại để có thể chạy nhanh hơn được nữa không nhỉ? Với dữ liệu trong file mình gửi kèm thì máy mình quay suốt chạy không nổi.

Nếu đúng như file up lên thì:

- bước 1 : tại
C1 nhập công thức: =MIN(A3:A335480)
C2 nhập công thức: =MAX(A3:A335480)

- bước 2 : dùng code sau
Tạm dùng cái này đi cho nhanh

.............

HieuCD · 20/10/19

tangoctuan đã viết:
Nhờ bạn Hiếu xem giúp có cách nào code lại để có thể chạy nhanh hơn được nữa không nhỉ? Với dữ liệu trong file mình gửi kèm thì máy mình quay suốt chạy không nổi.

Nếu số dòng dữ liệu lớn hơn số dòng kết quả nhiều

tangoctuan đã viết:
Nhờ bạn Hiếu xem giúp có cách nào code lại để có thể chạy nhanh hơn được nữa không nhỉ? Với dữ liệu trong file mình gửi kèm thì máy mình quay suốt chạy không nổi.

Với dữ liệu File, dùng mảng sẽ nhanh hơn nhiều, File khác có thể báo lổi

Mã:

Sub DoTim()
  Dim sArr(), dArr(), Arr(), Res()
  Dim fRow&, eRow&, eR1&, eR2&, i&, sRow&, R&
  With Sheet1
    eR1 = .Range("A" & Rows.Count).End(xlUp).Row
    eR2 = .Range("D" & Rows.Count).End(xlUp).Row
    If eR1 < 3 Or eR2 < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    
    fRow = Application.Min(.Range("A3:A" & eR1))
    i = Application.Min(.Range("D3:D" & eR2))
    If fRow > i Then fRow = i
    eRow = Application.Max(.Range("A3:A" & eR1))
    i = Application.Max(.Range("D3:D" & eR2))
    If eRow < i Then eRow = i
    
    sArr = .Range("A3:B" & eR1).Value2
    dArr = .Range("D3:E" & eR2).Value2
    Res = .Range("F3:F" & eR2).Value2
  End With
  ReDim Arr(fRow To eRow)
  sRow = UBound(sArr)
  For i = 1 To sRow
    Arr(sArr(i, 1)) = sArr(i, 2)
  Next i
  sRow = UBound(dArr)
  For i = 1 To sRow
    If dArr(i, 2) = 1 Then Res(i, 1) = Arr(dArr(i, 1))
  Next i
  Sheet1.Range("F3").Resize(sRow).Value = Res
End Sub

batman1 · 20/10/19

Về code ở bài #11.
1. Nếu Min(A:A) khác Max(A:A) rất nhiều thì sẽ có vấn đề. Vd. A3 = 12345678, A4 = 98765432 thì mảng Arr sẽ được cấp bộ nhớ = 1 382 716 064 B > 1 GB. Máy của tôi không chịu nổi.

Tuy nhiên tôi cho rằng các giá trị trong cột A trong công việc cụ thể này không khác nhau nhiều lắm. Đây chỉ là lưu ý bình thường. Ý thức về vấn đề.

2. Code không dùng được cho dữ liệu của bài #1.
-------------
Code ở bài #2 dùng cho mọi dữ liệu, cả ở bài #1 và cả ở bài #8. Nếu sửa 2 chỗ trong code thì tốc độ cải thiện rất nhiều. Tất nhiên tốc độ không thể bằng tốc độ của code ở bài #11 vì code ở bài #11 viết cho trường hợp cụ thể: dữ liệu cột A là số và không chênh lệch nhau nhiều.

Nếu ai tò mò thì trong code ở bài #2:
sửa

Mã:

.Item(sArr(i, 1)) = sArr(i, 2)

thành

Mã:

.Item(CStr(sArr(i, 1))) = sArr(i, 2)

Và sửa

Mã:

Res(i, 1) = .Item(dArr(i, 1))

thành

Mã:

Res(i, 1) = .Item(CStr(dArr(i, 1)))

ppc0312 · 20/10/19

batman1 đã viết:
Về code ở bài #11.
1. Nếu Min(A:A) khác Max(A:A) rất nhiều thì sẽ có vấn đề. Vd. A3 = 12345678, A4 = 98765432 thì mảng Arr sẽ được cấp bộ nhớ = 1 382 716 064 B > 1 GB. Máy của tôi không chịu nổi.

Tuy nhiên tôi cho rằng các giá trị trong cột A trong công việc cụ thể này không khác nhau nhiều lắm. Đây chỉ là lưu ý bình thường. Ý thức về vấn đề.

2. Code không dùng được cho dữ liệu của bài #1.
-------------
Code ở bài #2 dùng cho mọi dữ liệu, cả ở bài #1 và cả ở bài #8. Nếu sửa 2 chỗ trong code thì tốc độ cải thiện rất nhiều. Tất nhiên tốc độ không thể bằng tốc độ của code ở bài #11 vì code ở bài #11 viết cho trường hợp cụ thể: dữ liệu cột A là số và không chênh lệch nhau nhiều.

Nếu ai tò mò thì trong code ở bài #2:
sửa

Mã:

.Item(sArr(i, 1)) = sArr(i, 2)

thành

Mã:

.Item(CStr(sArr(i, 1))) = sArr(i, 2)

Và sửa

Mã:

Res(i, 1) = .Item(dArr(i, 1))

thành

Mã:

Res(i, 1) = .Item(CStr(dArr(i, 1)))

Đúng vậy, như bài #10 (bài #11 cùng cách giống vậy )đã viết

ppc0312 đã viết:
Nếu đúng như file up lên thì:
.......

tangoctuan · 20/10/19

HieuCD đã viết:

Nếu số dòng dữ liệu lớn hơn số dòng kết quả nhiều

Với dữ liệu File, dùng mảng sẽ nhanh hơn nhiều, File khác có thể báo lổi

Mã:

Sub DoTim()
  Dim sArr(), dArr(), Arr(), Res()
  Dim fRow&, eRow&, eR1&, eR2&, i&, sRow&, R&
  With Sheet1
    eR1 = .Range("A" & Rows.Count).End(xlUp).Row
    eR2 = .Range("D" & Rows.Count).End(xlUp).Row
    If eR1 < 3 Or eR2 < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
   
    fRow = Application.Min(.Range("A3:A" & eR1))
    i = Application.Min(.Range("D3:D" & eR2))
    If fRow > i Then fRow = i
    eRow = Application.Max(.Range("A3:A" & eR1))
    i = Application.Max(.Range("D3:D" & eR2))
    If eRow < i Then eRow = i
   
    sArr = .Range("A3:B" & eR1).Value2
    dArr = .Range("D3:E" & eR2).Value2
    Res = .Range("F3:F" & eR2).Value2
  End With
  ReDim Arr(fRow To eRow)
  sRow = UBound(sArr)
  For i = 1 To sRow
    Arr(sArr(i, 1)) = sArr(i, 2)
  Next i
  sRow = UBound(dArr)
  For i = 1 To sRow
    If dArr(i, 2) = 1 Then Res(i, 1) = Arr(dArr(i, 1))
  Next i
  Sheet1.Range("F3").Resize(sRow).Value = Res
End Sub

leonguyenz đã viết:

Code tương tự bài #2 của bác @HieuCD , chỉ viết khác 1 chút.

Mã:

Sub DoTim()
Dim dAr As Variant, sAr As Variant, i As Long
Dim Dic As Object, rAr As Variant
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    dAr = Range("A3:B" & Range("A3").End(xlDown).Row).Value2
    For i = 1 To UBound(dAr, 1)
        If Not Dic.Exists(dAr(i, 1)) Then
            Dic.Add dAr(i, 1), Array(dAr(i, 2))
        End If
    Next i
   
    sAr = Range("D3:F" & Range("D3").End(xlDown).Row).Value2
    ReDim rAr(1 To UBound(sAr, 1), 1 To 1)
    For i = 1 To UBound(sAr, 1)
        rAr(i, 1) = sAr(i, 3)
        If sAr(i, 2) = 1 And Dic.Exists(sAr(i, 1)) Then
            rAr(i, 1) = Dic.Item(sAr(i, 1))(0)
        End If
    Next i
    Range("G3").Resize(UBound(sAr, 1)) = rAr
End With
Set Dic = Nothing
End Sub

ppc0312 đã viết:

Nếu đúng như file up lên thì:

- bước 1 : tại
C1 nhập công thức: =MIN(A3:A335480)
C2 nhập công thức: =MAX(A3:A335480)

- bước 2 : dùng code sau
Tạm dùng cái này đi cho nhanh

Mã:

Sub DoTimARRAY()
    Dim t
    t = Timer
  Dim sArr(), dArr(), Res(), iArr()
  Dim n1&, n2&, i&
  Dim i1&, i2&

  With Sheet1
    n1 = .Range("A" & Rows.Count).End(xlUp).Row
    n2 = .Range("D" & Rows.Count).End(xlUp).Row
    If n1 < 3 Or n2 < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("A3:B" & n1).Value
    dArr = .Range("D3:E" & n2).Value
    i1 = .Range("C1") 'MIN
    i2 = .Range("C2") 'MAX
    Res = .Range("F3:F" & n2).Value
   
  End With
  n1 = n1 - 2
  n2 = n2 - 2
    ReDim iArr(i1 To i2)
    For i = 1 To n1
      iArr(sArr(i, 1)) = sArr(i, 2)
    Next i
  
  
    For i = 1 To n2
      If dArr(i, 2) = 1 Then
        Res(i, 1) = iArr(dArr(i, 1))
      End If
    Next i

  Sheet1.Range("F3").Resize(n2).Value = Res
  t = Timer - t
  MsgBox "Time t=" & t
End Sub

HieuCD đã viết:

Nếu số dòng dữ liệu lớn hơn số dòng kết quả nhiều

Với dữ liệu File, dùng mảng sẽ nhanh hơn nhiều, File khác có thể báo lổi

Mã:

Sub DoTim()
  Dim sArr(), dArr(), Arr(), Res()
  Dim fRow&, eRow&, eR1&, eR2&, i&, sRow&, R&
  With Sheet1
    eR1 = .Range("A" & Rows.Count).End(xlUp).Row
    eR2 = .Range("D" & Rows.Count).End(xlUp).Row
    If eR1 < 3 Or eR2 < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
   
    fRow = Application.Min(.Range("A3:A" & eR1))
    i = Application.Min(.Range("D3:D" & eR2))
    If fRow > i Then fRow = i
    eRow = Application.Max(.Range("A3:A" & eR1))
    i = Application.Max(.Range("D3:D" & eR2))
    If eRow < i Then eRow = i
   
    sArr = .Range("A3:B" & eR1).Value2
    dArr = .Range("D3:E" & eR2).Value2
    Res = .Range("F3:F" & eR2).Value2
  End With
  ReDim Arr(fRow To eRow)
  sRow = UBound(sArr)
  For i = 1 To sRow
    Arr(sArr(i, 1)) = sArr(i, 2)
  Next i
  sRow = UBound(dArr)
  For i = 1 To sRow
    If dArr(i, 2) = 1 Then Res(i, 1) = Arr(dArr(i, 1))
  Next i
  Sheet1.Range("F3").Resize(sRow).Value = Res
End Sub

batman1 đã viết:
Về code ở bài #11.
1. Nếu Min(A:A) khác Max(A:A) rất nhiều thì sẽ có vấn đề. Vd. A3 = 12345678, A4 = 98765432 thì mảng Arr sẽ được cấp bộ nhớ = 1 382 716 064 B > 1 GB. Máy của tôi không chịu nổi.

Tuy nhiên tôi cho rằng các giá trị trong cột A trong công việc cụ thể này không khác nhau nhiều lắm. Đây chỉ là lưu ý bình thường. Ý thức về vấn đề.

2. Code không dùng được cho dữ liệu của bài #1.
-------------
Code ở bài #2 dùng cho mọi dữ liệu, cả ở bài #1 và cả ở bài #8. Nếu sửa 2 chỗ trong code thì tốc độ cải thiện rất nhiều. Tất nhiên tốc độ không thể bằng tốc độ của code ở bài #11 vì code ở bài #11 viết cho trường hợp cụ thể: dữ liệu cột A là số và không chênh lệch nhau nhiều.

Nếu ai tò mò thì trong code ở bài #2:
sửa

Mã:

.Item(sArr(i, 1)) = sArr(i, 2)

thành

Mã:

.Item(CStr(sArr(i, 1))) = sArr(i, 2)

Và sửa

Mã:

Res(i, 1) = .Item(dArr(i, 1))

thành

Mã:

Res(i, 1) = .Item(CStr(dArr(i, 1)))

ppc0312 đã viết:
Đúng vậy, như bài #10 (bài #11 cùng cách giống vậy )đã viết

Cám ơn các bác đã chỉ giáo, tuy nhiên dữ liệu không phải lúc nào cũng là số ạ, lúc text, lúc number, có lúc là time hoặc lẫn tất cả. Number thì giá trị tiền có thể từ 0 hoặc âm cho tới hàng trăm triệu, hàng tỷ đồng (ở kết quả giá trị trả về, trong cùng 1 dải dò tìm). Nếu như vậy thì sẽ cần dùng đoạn code ntn để đáp ứng được tối ưu nhất? Chấp nhận không cần quá nhanh như code chỉ được viết riêng cho 1 t/hợp cụ thể, chỉ cần cải thiện được tốc độ một cách tốt nhất có thể là được rồi ạ. Cảm ơn mọi người rất nhiều!

tangoctuan · 20/10/19

Mình đã thử hết các cách ở trên và đã hiện giải quyết tốt được vấn đề rồi. Sau không rõ còn tình huống nào nữa không nhưng như hiện tại là chạy nhanh lắm rồi, mất có khoang trên dưới 2 phút thôi, so với trước mình ngồi uống hết cafe vẫn chưa xong.
Cám ơn các bro rất nhiều!

Bài đã được tự động gộp: 20/10/19

HieuCD đã viết:

Nếu số dòng dữ liệu lớn hơn số dòng kết quả nhiều

Với dữ liệu File, dùng mảng sẽ nhanh hơn nhiều, File khác có thể báo lổi

Mã:

Sub DoTim()
  Dim sArr(), dArr(), Arr(), Res()
  Dim fRow&, eRow&, eR1&, eR2&, i&, sRow&, R&
  With Sheet1
    eR1 = .Range("A" & Rows.Count).End(xlUp).Row
    eR2 = .Range("D" & Rows.Count).End(xlUp).Row
    If eR1 < 3 Or eR2 < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
   
    fRow = Application.Min(.Range("A3:A" & eR1))
    i = Application.Min(.Range("D3:D" & eR2))
    If fRow > i Then fRow = i
    eRow = Application.Max(.Range("A3:A" & eR1))
    i = Application.Max(.Range("D3:D" & eR2))
    If eRow < i Then eRow = i
   
    sArr = .Range("A3:B" & eR1).Value2
    dArr = .Range("D3:E" & eR2).Value2
    Res = .Range("F3:F" & eR2).Value2
  End With
  ReDim Arr(fRow To eRow)
  sRow = UBound(sArr)
  For i = 1 To sRow
    Arr(sArr(i, 1)) = sArr(i, 2)
  Next i
  sRow = UBound(dArr)
  For i = 1 To sRow
    If dArr(i, 2) = 1 Then Res(i, 1) = Arr(dArr(i, 1))
  Next i
  Sheet1.Range("F3").Resize(sRow).Value = Res
End Sub

File text chạy báo lỗi.

Bài đã được tự động gộp: 20/10/19

batman1 đã viết:
Về code ở bài #11.
1. Nếu Min(A:A) khác Max(A:A) rất nhiều thì sẽ có vấn đề. Vd. A3 = 12345678, A4 = 98765432 thì mảng Arr sẽ được cấp bộ nhớ = 1 382 716 064 B > 1 GB. Máy của tôi không chịu nổi.

Tuy nhiên tôi cho rằng các giá trị trong cột A trong công việc cụ thể này không khác nhau nhiều lắm. Đây chỉ là lưu ý bình thường. Ý thức về vấn đề.

2. Code không dùng được cho dữ liệu của bài #1.
-------------
Code ở bài #2 dùng cho mọi dữ liệu, cả ở bài #1 và cả ở bài #8. Nếu sửa 2 chỗ trong code thì tốc độ cải thiện rất nhiều. Tất nhiên tốc độ không thể bằng tốc độ của code ở bài #11 vì code ở bài #11 viết cho trường hợp cụ thể: dữ liệu cột A là số và không chênh lệch nhau nhiều.

Nếu ai tò mò thì trong code ở bài #2:
sửa

Mã:

.Item(sArr(i, 1)) = sArr(i, 2)

thành

Mã:

.Item(CStr(sArr(i, 1))) = sArr(i, 2)

Và sửa

Mã:

Res(i, 1) = .Item(dArr(i, 1))

thành

Mã:

Res(i, 1) = .Item(CStr(dArr(i, 1)))

Sửa lại code bác Hiếu theo như này thì chạy ngon lành luôn.

ppc0312 · 20/10/19

tangoctuan đã viết:
Cám ơn các bác đã chỉ giáo, tuy nhiên dữ liệu không phải lúc nào cũng là số ạ, lúc text, lúc number, có lúc là time hoặc lẫn tất cả. Number thì giá trị tiền có thể từ 0 hoặc âm cho tới hàng trăm triệu, hàng tỷ đồng (ở kết quả giá trị trả về, trong cùng 1 dải dò tìm). Nếu như vậy thì sẽ cần dùng đoạn code ntn để đáp ứng được tối ưu nhất? Chấp nhận không cần quá nhanh như code chỉ được viết riêng cho 1 t/hợp cụ thể, chỉ cần cải thiện được tốc độ một cách tốt nhất có thể là được rồi ạ. Cảm ơn mọi người rất nhiều!

ntn là gì vậy?

Tại sao Tiền lại làm key (khóa) để đi tìm kiếm vậy, nghi ngờ , nếu được bạn cho biết ứng dụng vào đâu?

tangoctuan đã viết:
Mình đã thử hết các cách ở trên và đã hiện giải quyết tốt được vấn đề rồi. Sau không rõ còn tình huống nào nữa không nhưng như hiện tại là chạy nhanh lắm rồi, mất có khoang trên dưới 2 phút thôi, so với trước mình ngồi uống hết cafe vẫn chưa xong.
Cám ơn các bro rất nhiều!

Bài đã được tự động gộp: 20/10/19

File text chạy báo lỗi.

Bài đã được tự động gộp: 20/10/19

Sửa lại code bác Hiếu theo như này thì chạy ngon lành luôn.

Áp dụng cái gì là do bạn quyết định thôi, chúng tôi có nhúng tay vào chạy hay áp dụng đâu

VetMini · 20/10/19

ppc0312 đã viết:
ntn là gì vậy?
...

Sẵn đó, bạn hỏi giùm tôi bro có nghĩa là gì luôn.
Nếu đúng theo tôi nghĩ thì từ đó chỉ giành cho chát chứ trên forrum thì không được lịch sự cho lắm (trừ mấy cái forrum chơi ghêm).

tangoctuan · 20/10/19

ppc0312 đã viết:
ntn là gì vậy?

Tại sao Tiền lại làm key (khóa) để đi tìm kiếm vậy, nghi ngờ , nếu được bạn cho biết ứng dụng vào đâu?

tangoctuan đã viết:
Number thì giá trị tiền có thể từ 0 hoặc âm cho tới hàng trăm triệu, hàng tỷ đồng (ở kết quả giá trị trả về, trong cùng 1 dải dò tìm)

Có gì đâu, hoàn toàn được. Nhưng mà trước hết mình thấy:
Lần trước thì bạn hỏi là 500 dòng thì cần gì code trong khi mình có nói rõ là 500k dòng.
Lần này thì bạn lại hỏi tiền làm key để tìm, trong khi mình cũng nói rất rõ là tiền là kết quả giá trị trả về khi dò tìm.
Có vẻ công việc của bạn khá là bận bịu nên thường ít khi đọc được kỹ.
Anw, vẫn có rất rất nhiều trường hợp tiền cũng là 1 key dò tìm thật sự, đối với tất cả mọi người chứ chẳng riêng gì mình. Chúng ta mỗi người chỉ làm 1 nghề, không thể biết hết mọi nghề của xã hội để có thể nghi ngờ vậy.
Với riêng mình, có thể tiền được dùng làm key để tìm ra khách hàng nào, thời điểm nào, ở địa điểm nào... tương ứng với giá trị tiền đó. Muôn hình muôn vẻ.
[/QUOTE]

Bài đã được tự động gộp: 20/10/19

VetMini đã viết:
Sẵn đó, bạn hỏi giùm tôi bro có nghĩa là gì luôn.
Nếu đúng theo tôi nghĩ thì từ đó chỉ giành cho chát chứ trên forrum thì không được lịch sự cho lắm (trừ mấy cái forrum chơi ghêm).

Cũng không hẳn như thế đâu, mình thì cũng ít khi dùng, nhưng bạn có thể dạo qua khá nhiều các forum lớn và uy tín, cả ở VN hay nước ngoài, thì có thể dễ dàng nhận ra từ đó được áp dụng rất thông dụng, với ý nghĩa trang trọng. Bro viết tắt của Brother, tức nói về người đối diện với một sự tôn trọng, nể trọng, như một người bề trên.

Ba Tê · 20/10/19

Bro viết tắt của Brother, tức nói về người đối diện với một sự tôn trọng, nể trọng, như một người bề trên.

Tại sao đang viết (giao tiếp) cả câu văn tiếng Việt lại xen vào 1 chữ viết tắt của tiếng "nước nào", khoe ngoại ngữ chăng?
Xin lỗi!
Thành viên GPE hiện có rất nhiều người đang sống, làm việc với người nước ngoài (hoặc đang làm việc ở nước ngoài) nhưng họ vẫn "thuần Việt" khi giao tiếp với người Việt.
Nửa nạc nửa mỡ (ba rọi) không làm nên một sự lịch lãm.

tangoctuan · 20/10/19

Ba Tê đã viết:
Bro viết tắt của Brother, tức nói về người đối diện với một sự tôn trọng, nể trọng, như một người bề trên.

Tại sao đang viết (giao tiếp) cả câu văn tiếng Việt lại xen vào 1 chữ viết tắt của tiếng "nước nào", khoe ngoại ngữ chăng?
Xin lỗi!
Thành viên GPE hiện có rất nhiều người đang sống, làm việc với người nước ngoài (hoặc đang làm việc ở nước ngoài) nhưng họ vẫn "thuần Việt" khi giao tiếp với người Việt.
Nửa nạc nửa mỡ (ba rọi) không làm nên một sự lịch lãm.

Có rất nhiều từ/cụm từ là ngôn ngữ không phải của Việt Nam nhưng vẫn thường xuyên được sử dụng trong lời nói, diễn đạt của người Việt. Tks, sorry, email, smartphone, welcome, Ok, share, fairplay...
Và không nói gì tới tiếng Anh, mà tiếng Trung Quốc cũng là một dạng ngoại ngữ. Mà tiếng Trung thì quá phổ biến trong ngôn ngữ nói của người Việt.
Có rất nhiều trường hợp trong lời nói có 1 ý hay 1 từ nào đó người nói diễn đạt bằng tiếng ngoại ngữ, và họ không hề có ý muốn khoe khoang. Đơn giản chỉ như 1 thói quen, hoặc có thể chưa tìm được từ tiếng Việt phù hợp hơn.
Mình rất ngạc nhiên nếu bạn chưa bao giờ gặp trường hợp nào như vậy đấy.
Nếu là định khoe khoang thì sẽ phải thể hiện ở một hình thái khác. Tuy nhiên tất cả đều ở sự nhìn nhận của mỗi người, góc nhìn của từng người là khác nhau. Cùng 1 nội dung người này hiểu ở trạng thái tích cực, còn người kia hiểu ngược lại.
Còn khi với những người nghe đã có sự nhìn nhận như thế thì chắc chắn người nói sẽ cần phải rút kinh nghiệm.
P/s: Mình không nói tới bro, mà chỉ trả lời ý hỏi của bạn V khi hỏi về bro thôi.

Dò tìm chính xác tuyệt đối

Thành viên hoạt động

File đính kèm

Chuyên gia GPE

Thành viên gạo cội

Chuyên gia GPE

whom?

Thành viên hoạt động

Ăn cùng góc phố

Thành viên hoạt động

File đính kèm

whom?

whom?

Chuyên gia GPE

Thành viên gạo cội

whom?

Thành viên hoạt động

Thành viên hoạt động

whom?

Ăn cùng góc phố

Thành viên hoạt động

Cạo Rồi Khỏi Gội

Thành viên hoạt động

Đếm ngược thời gian