Nhờ các bạn sửa hộ code cho mượt hơn (1 người xem)

maiban116 · 13/5/18

Function VH(S1 As String, Rng As Range, RngTT As Range) As String
Dim i As Long, j As Long, Tmp, TmpTT
S = Split(S1, " ")
TmpTT = RngTT
Tmp = Rng
ReDim Arr(1 To UBound(S) + 1)
For i = 1 To UBound(S) + 1
For j = 1 To UBound(TmpTT)
If LCase(S(i - 1)) = LCase(TmpTT(j, 1)) Then
Arr(i) = TmpTT(j, 2)
GoTo tiep
End If
Next
For j = 1 To UBound(Tmp)
If LCase(S(i - 1)) = LCase(Tmp(j, 1)) Then
Arr(i) = Tmp(j, 2)
GoTo tiep
End If
Next
tiep:
Next
VH = Join(Arr(), " ")
End Function
và làm cách nào khi rò không có thì trả về giá trị rò. xin cảm ơn

♫ђöล♥ßล†♥†µ♫ · 13/5/18

maiban116 đã viết:
Function VH(S1 As String, Rng As Range, RngTT As Range) As String
Dim i As Long, j As Long, Tmp, TmpTT
S = Split(S1, " ")
TmpTT = RngTT
Tmp = Rng
ReDim Arr(1 To UBound(S) + 1)
For i = 1 To UBound(S) + 1
For j = 1 To UBound(TmpTT)
If LCase(S(i - 1)) = LCase(TmpTT(j, 1)) Then
Arr(i) = TmpTT(j, 2)
GoTo tiep
End If
Next
For j = 1 To UBound(Tmp)
If LCase(S(i - 1)) = LCase(Tmp(j, 1)) Then
Arr(i) = Tmp(j, 2)
GoTo tiep
End If
Next
tiep:
Next
VH = Join(Arr(), " ")
End Function
và làm cách nào khi rò không có thì trả về giá trị rò. xin cảm ơn

Bạn phải nói thêm về công dụng của hàm hoặc là đính kèm file thì dễ hơn. Mà cái hàm này bị sao vậy bạn. Có chỗ nào bị thủng à. Sao mà thấy "rò" miết vậy

maiban116 · 13/5/18

trước hết xin cảm ơn bạn. một là nó khiến hàm tra rất nặng khi thêm vào từ cần tra. thứ 2 mình muốn nhờ khi không tra được từ cần tra thì nó sẽ trả về chính cái từ dó. nhờ các bạn xem hộ

♫ђöล♥ßล†♥†µ♫ · 13/5/18

maiban116 đã viết:
trước hết xin cảm ơn bạn. một là nó khiến hàm tra rất nặng khi thêm vào từ cần tra. thứ 2 mình muốn nhờ khi không tra được từ cần tra thì nó sẽ trả về chính cái từ dó. nhờ các bạn xem hộ

Ít ra thì cho xin cái file để kiểm tra hàm nóa chậy làm sao chứ

♫ђöล♥ßล†♥†µ♫ · 13/5/18

maiban116 đã viết:
trước hết xin cảm ơn bạn. một là nó khiến hàm tra rất nặng khi thêm vào từ cần tra. thứ 2 mình muốn nhờ khi không tra được từ cần tra thì nó sẽ trả về chính cái từ dó. nhờ các bạn xem hộ

Bạn kiểm tra thử. Chắc sai tòe loe trong đó $-\\/.$

Mã:

Function Timkiem(ByVal Str As String, ByVal fRng As Range, ByVal eRng As Range) As String
    Dim Tmp, I As Long, J As Long, Nkt As Long
    Dim Dic As Object, R As Long, Arr(), n As Long
Set Dic = CreateObject("Scripting.Dictionary")
Str = Application.Trim(Str)
For I = 1 To fRng.Rows.Count
    Dic.Item(UCase(fRng(I))) = I
Next I
Tmp = Split(Str, " "): Nkt = UBound(Tmp) + 1
For J = LBound(Tmp) To UBound(Tmp)
    R = Dic.Item(UCase(Tmp(J)))
    If R Then
        n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = Application.Trim(eRng(R))
    End If
Next
If n = Nkt Then
    Timkiem = Join(Arr(), " ")
Else
    Timkiem = Str
End If
End Function

maiban116 · 13/5/18

♫ђöล♥ßล†♥†µ♫ đã viết:

Bạn kiểm tra thử. Chắc sai tòe loe trong đó $-\\/.$

Mã:

Function Timkiem(ByVal Str As String, ByVal fRng As Range, ByVal eRng As Range) As String
    Dim Tmp, I As Long, J As Long, Nkt As Long
    Dim Dic As Object, R As Long, Arr(), n As Long
Set Dic = CreateObject("Scripting.Dictionary")
Str = Application.Trim(Str)
For I = 1 To fRng.Rows.Count
    Dic.Item(UCase(fRng(I))) = I
Next I
Tmp = Split(Str, " "): Nkt = UBound(Tmp) + 1
For J = LBound(Tmp) To UBound(Tmp)
    R = Dic.Item(UCase(Tmp(J)))
    If R Then
        n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = Application.Trim(eRng(R))
    End If
Next
If n = Nkt Then
    Timkiem = Join(Arr(), " ")
Else
    Timkiem = Str
End If
End Function

cám ơn bạn nhiều. bây giờ muốn thê tra ở cootjphuj thiflamf thế nào nhỉ

♫ђöล♥ßล†♥†µ♫ · 13/5/18

maiban116 đã viết:
cám ơn bạn nhiều. bây giờ muốn thê tra ở cootjphuj thiflamf thế nào nhỉ

Em mà hiểu được Bác đang nói gì em chết liền

Mộng Thường 2001 · 13/5/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Em mà hiểu được Bác đang nói gì em chết liền

"Hoa bất tử" nàm sao chít được hử!?
hihi ^o^

giaiphap · 13/5/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Em mà hiểu được Bác đang nói gì em chết liền

Bác lên google nhờ dịch cho mà hiểu.

♫ђöล♥ßล†♥†µ♫ · 13/5/18

Mộng Thường 2001 đã viết:
"Hoa bất tử" nàm sao chít được hử!?
hihi ^o^

hi hi. Vậy em mới không hiểu được cái đoạn văn trên anh ấy định nói gì
@maiban116
Bác sử dụng Code dưới (Có dùng 1 hàm của Thầy NDu) tốc độ nhanh gấp 2 lần Code bài 5

Mã:

Function Timkiem(ByVal Str As String, ByVal fRng, ByVal eRng) As String
    Dim Tmp, I As Long, Nkt As Long
    Dim Dic As Object, R As Long, sArr(), tArr(), Arr(), n As Long
Set Dic = CreateObject("Scripting.Dictionary")
Str = Application.Trim(Str)
sArr = ConvertTo1DArray(fRng)
tArr = ConvertTo1DArray(eRng)
For I = 1 To UBound(sArr)
   If sArr(I) <> Empty Then Dic.Item(UCase(sArr(I))) = I
Next I
Tmp = Split(Str, " "): Nkt = UBound(Tmp) + 1
For I = LBound(Tmp) To UBound(Tmp)
    R = Dic.Item(UCase(Tmp(I)))
    If R Then
        n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = Application.Trim(tArr(R))
    End If
Next I
If n = Nkt Then
    Timkiem = Join(Arr(), " ")
Else
    Timkiem = Str
End If
End Function
Private Function ConvertTo1DArray(ByVal SourceArray)
    Dim aTmp, Item, Arr()
    Dim n As Long
    On Error Resume Next
    aTmp = SourceArray
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
        n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = Item
    Next
    ConvertTo1DArray = Arr
End Function

♫ђöล♥ßล†♥†µ♫ · 13/5/18

giaiphap đã viết:
Bác lên google nhờ dịch cho mà hiểu.

Thầy ơi. Google họ bảo bó cả tay lẫn chân rùi ạ

maiban116 · 13/5/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Thầy ơi. Google họ bảo bó cả tay lẫn chân rùi ạ

xin nỗi các bác nhé. Cò nhà em nó ấn vào mong các bác thông cảm

HieuCD · 13/5/18

♫ђöล♥ßล†♥†µ♫ đã viết:

hi hi. Vậy em mới không hiểu được cái đoạn văn trên anh ấy định nói gì
@maiban116
Bác sử dụng Code dưới (Có dùng 1 hàm của Thầy NDu) tốc độ nhanh gấp 2 lần Code bài 5

Mã:

Function Timkiem(ByVal Str As String, ByVal fRng, ByVal eRng) As String
    Dim Tmp, I As Long, Nkt As Long
    Dim Dic As Object, R As Long, sArr(), tArr(), Arr(), n As Long
Set Dic = CreateObject("Scripting.Dictionary")
Str = Application.Trim(Str)
sArr = ConvertTo1DArray(fRng)
tArr = ConvertTo1DArray(eRng)
For I = 1 To UBound(sArr)
   If sArr(I) <> Empty Then Dic.Item(UCase(sArr(I))) = I
Next I
Tmp = Split(Str, " "): Nkt = UBound(Tmp) + 1
For I = LBound(Tmp) To UBound(Tmp)
    R = Dic.Item(UCase(Tmp(I)))
    If R Then
        n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = Application.Trim(tArr(R))
    End If
Next I
If n = Nkt Then
    Timkiem = Join(Arr(), " ")
Else
    Timkiem = Str
End If
End Function
Private Function ConvertTo1DArray(ByVal SourceArray)
    Dim aTmp, Item, Arr()
    Dim n As Long
    On Error Resume Next
    aTmp = SourceArray
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
        n = n + 1
        ReDim Preserve Arr(1 To n)
        Arr(n) = Item
    Next
    ConvertTo1DArray = Arr
End Function

Sao đọc code và mình chạy thử thấy chậm hơn mà

Không lẽ mình nhầm

♫ђöล♥ßล†♥†µ♫ · 13/5/18

HieuCD đã viết:
Sao đọc code và mình chạy thử thấy chậm hơn mà Không lẽ mình nhầm

Đầu tiên em chạy thử với 5000 dòng thì nhanh hơn gần gấp 3. Sau này đưa lên hơn 100.000 dòng thì nó chậm hơn anh ạ

HieuCD · 13/5/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Bạn phải nói thêm về công dụng của hàm hoặc là đính kèm file thì dễ hơn. Mà cái hàm này bị sao vậy bạn. Có chỗ nào bị thủng à. Sao mà thấy "rò" miết vậy

Để mình dịch lại code cho bạn hình dung cách vận hành

Mã:

Function VH(S1 As String, Rng As Range, RngTT As Range) As String
    Dim i As Long, j As Long, Tmp, TmpTT
    S = Split(S1, " ")
    TmpTT = RngTT
    Tmp = Rng
    ReDim Arr(1 To UBound(S) + 1)
    For i = 1 To UBound(S) + 1
        For j = 1 To UBound(TmpTT)
            If LCase(S(i - 1)) = LCase(TmpTT(j, 1)) Then
                Arr(i) = TmpTT(j, 2)
                GoTo tiep
            End If
        Next
        For j = 1 To UBound(Tmp)
            If LCase(S(i - 1)) = LCase(Tmp(j, 1)) Then
                Arr(i) = Tmp(j, 2)
                GoTo tiep
            End If
        Next
tiep:
    Next
    VH = Join(Arr(), " ")
End Function

1 từ đồng âm có nhiều cách viết Hán Việt, nên phải lập 2 bảng tra, nhằm lấy đúng từ cần thiết và tăng tốc độ code
Rng là bảng tra chính chứa toàn bộ các từ tra chuổi S1 gồm 2 cột: Cột 1 Từ tra, cột 2 kết quả
RngTT là bảng tra phụ được lập cho từng tình huống, những từ cần tra nào có nhiều kết quả và trả kết quả không đúng nếu tra từ Rng thì nhập từ cần tra và kết quả đúng vào RngTT
Code ưu tiên xử lý trên RngTT trước, nếu không tìm được từ tra mới tìm tiếp trên Rng

HieuCD · 13/5/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Đầu tiên em chạy thử với 5000 dòng thì nhanh hơn gần gấp 3. Sau này đưa lên hơn 100.000 dòng thì nó chậm hơn anh ạ

Hai code có cách dùng key của dic khác nhau nên tốc độ lúc nhanh lúc chậm
Mình nghỉ Function ConvertTo1DArray(ByVal SourceArray) trong trường hợp nầy không cần thiết và chỉ thêm 1 bước xử lý trung gian

maiban116 · 13/5/18

HieuCD đã viết:
Hai code có cách dùng key của dic khác nhau nên tốc độ lúc nhanh lúc chậm
Mình nghỉ Function ConvertTo1DArray(ByVal SourceArray) trong trường hợp nầy không cần thiết và chỉ thêm 1 bước xử lý trung gian

Đúng vậy. như ♫ђöล♥ßล†♥†µ♫ nói nhưng có cách nào khắc phụ điểm yếu của code mà bác tạo ra cho nhanh hơn nữa không bác HieuCD . nếu được thì hay quá

maiban116 · 13/5/18

có cách nào không bạn hiếu ơi

HieuCD · 13/5/18

maiban116 đã viết:
có cách nào không bạn hiếu ơi

Dụng cụ đào đất ở Miền tây có rất nhiều loại khác nhau, tùy theo muốn đào cái gì mà chọn loại dụng cụ khác nhau, đào hố nhỏ trồng cây sẽ khác rất nhiều với đào 1 vuông tôm, muốn dùng 1 Function dùng cho tất cả trường hợp mà chạy nhanh hơi khó
Thử cách hướng dẫn trong File, hơi khó sử dụng nhưng tốc độ tăng lên nhiều lần do chỉ chạy code 1 lần cho nhiều ô

maiban116 · 13/5/18

HieuCD đã viết:
Dụng cụ đào đất ở Miền tây có rất nhiều loại khác nhau, tùy theo muốn đào cái gì mà chọn loại dụng cụ khác nhau, đào hố nhỏ trồng cây sẽ khác rất nhiều với đào 1 vuông tôm, muốn dùng 1 Function dùng cho tất cả trường hợp mà chạy nhanh hơi khó
Thử cách hướng dẫn trong File, hơi khó sử dụng nhưng tốc độ tăng lên nhiều lần do chỉ chạy code 1 lần cho nhiều ô

bác HieuCD ơi chạy còn chậm hơn bản gốc của bác, hơn nữa xóa cột G:H đi nó không tra ở cột E:F

♫ђöล♥ßล†♥†µ♫ · 13/5/18

maiban116 đã viết:
bác HieuCD ơi chạy còn chậm hơn bản gốc của bác, hơn nữa xóa cột G:H đi nó không tra ở cột E:F

Tới 172.000 dòng dữ liệu như thế là quá tốt rồi Bác à

♫ђöล♥ßล†♥†µ♫ · 13/5/18

HieuCD đã viết:
Dụng cụ đào đất ở Miền tây có rất nhiều loại khác nhau, tùy theo muốn đào cái gì mà chọn loại dụng cụ khác nhau, đào hố nhỏ trồng cây sẽ khác rất nhiều với đào 1 vuông tôm, muốn dùng 1 Function dùng cho tất cả trường hợp mà chạy nhanh hơi khó
Thử cách hướng dẫn trong File, hơi khó sử dụng nhưng tốc độ tăng lên nhiều lần do chỉ chạy code 1 lần cho nhiều ô

Anh ơi em vừa làm được phiên bản Made-in-China
Tại B2 gõ công thức =vh(A2:A10;$E$2:$F$17200;$H$2:$I$12) xong Nhấn Ctrl+Shift+Enter là nó tự điền xuống dưới. Không phải bôi đen từ B2 đến B10 nữa

HieuCD · 13/5/18

maiban116 đã viết:
bác HieuCD ơi chạy còn chậm hơn bản gốc của bác, hơn nữa xóa cột G:H đi nó không tra ở cột E:F

Do bảng tra lớn nên chạy chậm, bảng tra chính có bao nhiêu dòng?
Kiểm tra lại file

maiban116 · 13/5/18

HieuCD đã viết:
Do bảng tra lớn nên chạy chậm, bảng tra chính có bao nhiêu dòng?
Kiểm tra lại file

cám ơn bác HieuCD sao nó không lấy từ đầu tiên tìm thấy nhỉ, Bác xem lại dùm

HieuCD · 13/5/18

maiban116 đã viết:
cám ơn bác HieuCD sao nó không lấy từ đầu tiên tìm thấy nhỉ, Bác xem lại dùm

Chỉnh lại code

Mã:

Function VH(ByVal tmp As Variant, ByVal Rng As Range, ByVal RngTT As Range) As Variant
  Dim Dic As Object, DicTT As Object, Res(), sArr(), S As Variant, key
  Dim i As Long, k As Long

  sArr = ConvertTo1DArray(tmp)
  ReDim Res(LBound(sArr) To UBound(sArr), 1 To 1)
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 1 To Rng.Rows.Count
    key = LCase(Rng(i, 1).Value)
    If Len(key) Then
      If Not Dic.exists(key) Then Dic.Add key, Rng(i, 2).Value
    End If
  Next i
  Set DicTT = CreateObject("Scripting.Dictionary")
  For i = 1 To RngTT.Rows.Count
    key = LCase(RngTT(i, 1).Value)
    If Len(key) Then
      If Not DicTT.exists(key) Then DicTT.Add key, RngTT(i, 2).Value
    End If
  Next i
  For k = LBound(sArr) To UBound(sArr)
    If Len(sArr(k)) Then
      S = Split(Application.Trim(sArr(k)), " ")
      For i = LBound(S) To UBound(S)
        key = LCase(S(i))
        If DicTT.exists(key) Then
          S(i) = DicTT.Item(key)
        Else
          If Dic.exists(key) Then S(i) = Dic.Item(key)
        End If
      Next i
      Res(k, 1) = Join(S, " ")
    End If
  Next
  VH = Res
  Set Dic = Nothing: Set DicTT = Nothing
End Function

maiban116 · 13/5/18

nếu chữ thiếu hoạc không có thì nó không báo chữ ? nhỉ bạn HieuCD

HieuCD · 13/5/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Anh ơi em vừa làm được phiên bản Made-in-China
Tại B2 gõ công thức =vh(A2:A10;$E$2:$F$17200;$H$2:$I$12) xong Nhấn Ctrl+Shift+Enter là nó tự điền xuống dưới. Không phải bôi đen từ B2 đến B10 nữa

Cái nầy hay quá

HieuCD · 13/5/18

maiban116 đã viết:
nếu chữ thiếu hoạc không có thì nó không báo chữ ? nhỉ bạn HieuCD

Ý bạn là gì, gởi file minh họa

maiban116 · 13/5/18

lam sao mình xóa cột A đi mà nó trả về khoảng trống bạn nhỉ

HieuCD · 13/5/18

maiban116 đã viết:
lam sao mình xóa cột A đi mà nó trả về khoảng trống bạn nhỉ

Dùng thêm hàm If
=IF(A2:A10="","",vh(A2:A10,$E$2:$F$1720,$H$2:$I$12))
Hoặc
=SUBSTITUTE(vh(A2:A10,$E$2:$F$1720,$H$2:$I$12),0,"")

♫ђöล♥ßล†♥†µ♫ · 13/5/18

HieuCD đã viết:
Cái nầy hay quá

Cái đồ Made-in-China thêm một ít bẫy lỗi nữa áp dụng vào điều kiện cố định là thành hàng nhái của anh Tuân xuất xứ từ Việt Nam cũng không chừng anh nhỉ

HieuCD · 13/5/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Cái đồ Made-in-China thêm một ít bẫy lỗi nữa áp dụng vào điều kiện cố định là thành hàng nhái của anh Tuân xuất xứ từ Việt Nam cũng không chừng anh nhỉ

Mình mới thấy dạng code nầy lần đầu, tùy biến lại cho tình huống cụ thể, bỏ bớt mấy lệnh thừa, thêm điều kiện thực thi lệnh là chạy ngon

♫ђöล♥ßล†♥†µ♫ · 13/5/18

HieuCD đã viết:
Mình mới thấy dạng code nầy lần đầu, tùy biến lại cho tình huống cụ thể, bỏ bớt mấy lệnh thừa, thêm điều kiện thực thi lệnh là chạy ngon

Cái này áp dụng hàm mảng vào lọc dữ liệu theo đối tượng thì dễ tùy biến hơn so với Code anh ạ

VetMini · 13/5/18

@HieuCD & ♫ђöล♥ßล†♥†µ♫
Hàm của các bạn là hàm tự tạo, gõ vào 1000 ô là nó chạy 1000 lần. Bạn có thấy là nếu cái Range cần dò nó không thay đổi thì bảng tính phải lập lại cái đít sần 1000 lần?

Cách cải tién là dùng 1 cái đít sần tĩnh static.

static dic as object
' hàm sử dụng nó đầu tiên thì phải khởi
if dic is nothing then set dic = createobject(...)
' đoạn code sau đây kiểm lại cái range dò xem có thay đổi hay không
if not dic.exists("curRange: " & Rng.Address) then
dic.RemoveAll ' xoá hết dữ liệu
... code nhét dữ liệu vào dic ở đây ...
dic.Add "curRange: " & Rng.Address, "" ' ghi lại để nó nhớ lần tới, không phải lặp lại
end if
' dic sẵn sàng để dò ở đây
...

Chú: nếu bạn không thoải mái với biến tĩnh thì dùng biến toàn cục cũng được.

truongvu317 · 13/5/18

VetMini đã viết:
@HieuCD & ♫ђöล♥ßล†♥†µ♫
Hàm của các bạn là hàm tự tạo, gõ vào 1000 ô là nó chạy 1000 lần. Bạn có thấy là nếu cái Range cần dò nó không thay đổi thì bảng tính phải lập lại cái đít sần 1000 lần?

Cách cải tién là dùng 1 cái đít sần tĩnh static.

static dic as object
' hàm sử dụng nó đầu tiên thì phải khởi
if dic is nothing then set dic = createobject(...)
' đoạn code sau đây kiểm lại cái range dò xem có thay đổi hay không
if not dic.exists("curRange: " & Rng.Address) then
dic.RemoveAll ' xoá hết dữ liệu
... code nhét dữ liệu vào dic ở đây ...
dic.Add "curRange: " & Rng.Address, "" ' ghi lại để nó nhớ lần tới, không phải lặp lại
end if
' dic sẵn sàng để dò ở đây
...

Chú: nếu bạn không thoải mái với biến tĩnh thì dùng biến toàn cục cũng được.

Dùng biến toàn cục, thực ra nó lại gồm 2 loại, loại toàn cục cấp dự án (public), hoặc toàn cục cấp modun ( private).
Còn một cách viết dưới dạng công thức mảng, hay viết dưới dạng thủ tục cũng được ( sub).

HieuCD · 13/5/18

truongvu317 đã viết:
Dùng biến toàn cục, thực ra nó lại gồm 2 loại, loại toàn cục cấp dự án (public), hoặc toàn cục cấp modun ( private).
Còn một cách viết dưới dạng công thức mảng, hay viết dưới dạng thủ tục cũng được ( sub).

Bạn cho ví dụ để mình biết thêm cách mới về dạng công thức mảng

batman1 · 14/5/18

maiban116 đã viết:
bác HieuCD ơi chạy còn chậm hơn bản gốc của bác,

Chậm là đương nhiên.

Mã:

For i = 1 To Rng.Rows.Count
    key = Rng(i, 1).Value
    If Len(key) Then Dic.Item(LCase(key)) = Rng(i, 2).Value
Next i

Code trong vòng lặp trên đọc giá trị của từng ô từ sheet. Tổng cộng đọc 172000 lần vào key và đọc 171972 lần để thêm vào Dic. Vấn đề tương tự với vòng FOR thứ 2.

Nên nhớ là khi dữ liệu lớn thì cấm tuyệt đối đọc (ghi) từng cell từ (vào) sheet

Tôi chỉ sửa những chỗ "nhạy cảm".

Chú ý: tôi lấy code từ 1 bài trước, sau đó thấy có code mới nhưng ngại dò xem có chỗ nào thay đổi. Nói chung triết lý thì như code dưới đây. Tức đọc dữ liệu 1 lần từ sheet vào mảng sau đó trong vòng FOR thì dò trong mảng thôi.

Mã:

Function VH(ByVal tmp As Range, ByVal Rng As Range, ByVal RngTT As Range) As Variant
  Dim Dic As Object, DicTT As Object, Res(), sArr(), aRngTT(), aRng(), S As Variant, key
  Dim i As Long, k As Long

  sArr = tmp.Value
  aRng = Rng.Value
  aRngTT = RngTT.Value
  ReDim Res(LBound(sArr) To UBound(sArr), 1 To 1)
  
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(aRng)
    key = aRng(i, 1)
    If Len(key) Then Dic.Item(LCase(key)) = aRng(i, 2)
  Next i
  Set DicTT = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(aRngTT)
    key = aRngTT(i, 1)
    If Len(key) Then DicTT.Item(LCase(key)) = aRngTT(i, 2)
  Next i
  For k = LBound(sArr) To UBound(sArr)
    If Len(sArr(k, 1)) Then
      S = Split(Application.Trim(sArr(k, 1)), " ")
      For i = LBound(S) To UBound(S)
        key = LCase(S(i))
        If DicTT.exists(key) Then
          S(i) = DicTT.Item(key)
        Else
          If Dic.exists(key) Then S(i) = Dic.Item(key)
        End If
      Next i
      Res(k, 1) = Join(S, " ")
    End If
  Next
  VH = Res
  Set Dic = Nothing: Set DicTT = Nothing
End Function

maiban116 · 14/5/18

batman1 đã viết:
Chậm là đương nhiên.

Mã:

For i = 1 To Rng.Rows.Count key = Rng(i, 1).Value If Len(key) Then Dic.Item(LCase(key)) = Rng(i, 2).Value Next i

Code trong vòng lặp trên đọc giá trị của từng ô từ sheet. Tổng cộng đọc 172000 lần vào key và đọc 171972 lần để thêm vào Dic. Vấn đề tương tự với vòng FOR thứ 2.

Nên nhớ là khi dữ liệu lớn thì cấm tuyệt đối đọc (ghi) từng cell từ (vào) sheet

Tôi chỉ sửa những chỗ "nhạy cảm".

Chú ý: tôi lấy code từ 1 bài trước, sau đó thấy có code mới nhưng ngại dò xem có chỗ nào thay đổi. Nói chung triết lý thì như code dưới đây. Tức đọc dữ liệu 1 lần từ sheet vào mảng sau đó trong vòng FOR thì dò trong mảng thôi.

Mã:

Function VH(ByVal tmp As Range, ByVal Rng As Range, ByVal RngTT As Range) As Variant Dim Dic As Object, DicTT As Object, Res(), sArr(), aRngTT(), aRng(), S As Variant, key Dim i As Long, k As Long sArr = tmp.Value aRng = Rng.Value aRngTT = RngTT.Value ReDim Res(LBound(sArr) To UBound(sArr), 1 To 1) Set Dic = CreateObject("Scripting.Dictionary") For i = 1 To UBound(aRng) key = aRng(i, 1) If Len(key) Then Dic.Item(LCase(key)) = aRng(i, 2) Next i Set DicTT = CreateObject("Scripting.Dictionary") For i = 1 To UBound(aRngTT) key = aRngTT(i, 1) If Len(key) Then DicTT.Item(LCase(key)) = aRngTT(i, 2) Next i For k = LBound(sArr) To UBound(sArr) If Len(sArr(k, 1)) Then S = Split(Application.Trim(sArr(k, 1)), " ") For i = LBound(S) To UBound(S) key = LCase(S(i)) If DicTT.exists(key) Then S(i) = DicTT.Item(key) Else If Dic.exists(key) Then S(i) = Dic.Item(key) End If Next i Res(k, 1) = Join(S, " ") End If Next VH = Res Set Dic = Nothing: Set DicTT = Nothing End Function

áp dụng lệnh như thế nào bạn ơi

truongvu317 · 14/5/18

batman1 đã viết:
Chậm là đương nhiên.

Mã:

For i = 1 To Rng.Rows.Count key = Rng(i, 1).Value If Len(key) Then Dic.Item(LCase(key)) = Rng(i, 2).Value Next i

Code trong vòng lặp trên đọc giá trị của từng ô từ sheet. Tổng cộng đọc 172000 lần vào key và đọc 171972 lần để thêm vào Dic. Vấn đề tương tự với vòng FOR thứ 2.

Nên nhớ là khi dữ liệu lớn thì cấm tuyệt đối đọc (ghi) từng cell từ (vào) sheet

Tôi chỉ sửa những chỗ "nhạy cảm".

Chú ý: tôi lấy code từ 1 bài trước, sau đó thấy có code mới nhưng ngại dò xem có chỗ nào thay đổi. Nói chung triết lý thì như code dưới đây. Tức đọc dữ liệu 1 lần từ sheet vào mảng sau đó trong vòng FOR thì dò trong mảng thôi.

Mã:

Function VH(ByVal tmp As Range, ByVal Rng As Range, ByVal RngTT As Range) As Variant Dim Dic As Object, DicTT As Object, Res(), sArr(), aRngTT(), aRng(), S As Variant, key Dim i As Long, k As Long sArr = tmp.Value aRng = Rng.Value aRngTT = RngTT.Value ReDim Res(LBound(sArr) To UBound(sArr), 1 To 1) Set Dic = CreateObject("Scripting.Dictionary") For i = 1 To UBound(aRng) key = aRng(i, 1) If Len(key) Then Dic.Item(LCase(key)) = aRng(i, 2) Next i Set DicTT = CreateObject("Scripting.Dictionary") For i = 1 To UBound(aRngTT) key = aRngTT(i, 1) If Len(key) Then DicTT.Item(LCase(key)) = aRngTT(i, 2) Next i For k = LBound(sArr) To UBound(sArr) If Len(sArr(k, 1)) Then S = Split(Application.Trim(sArr(k, 1)), " ") For i = LBound(S) To UBound(S) key = LCase(S(i)) If DicTT.exists(key) Then S(i) = DicTT.Item(key) Else If Dic.exists(key) Then S(i) = Dic.Item(key) End If Next i Res(k, 1) = Join(S, " ") End If Next VH = Res Set Dic = Nothing: Set DicTT = Nothing End Function

Like anh luôn! duyệt từng ô sẽ rất là chậm.

HieuCD đã viết:
Bạn cho ví dụ để mình biết thêm cách mới về dạng công thức mảng

Nói là công thức mảng cho nó sang cái miệng, chứ nó cũng như bao hàm khác thôi, chỉ là nó trả về mảng thay vì một giá trị, bạn làm cái này suốt rồi sao lại hỏi tui chứ, hishis hí hsis

batman1 · 14/5/18

maiban116 đã viết:
áp dụng lệnh như thế nào bạn ơi

Tôi lấy hàm mà bạn đã dùng, đã chạy và kêu là chậm. Tôi chỉ sửa lại code thôi. Chả lẽ sửa code thì cách dùng lại khác?

HieuCD · 14/5/18

batman1 đã viết:
Chậm là đương nhiên.

Mã:

For i = 1 To Rng.Rows.Count key = Rng(i, 1).Value If Len(key) Then Dic.Item(LCase(key)) = Rng(i, 2).Value Next i

Code trong vòng lặp trên đọc giá trị của từng ô từ sheet. Tổng cộng đọc 172000 lần vào key và đọc 171972 lần để thêm vào Dic. Vấn đề tương tự với vòng FOR thứ 2.

Nên nhớ là khi dữ liệu lớn thì cấm tuyệt đối đọc (ghi) từng cell từ (vào) sheet

Tôi chỉ sửa những chỗ "nhạy cảm".

Chú ý: tôi lấy code từ 1 bài trước, sau đó thấy có code mới nhưng ngại dò xem có chỗ nào thay đổi. Nói chung triết lý thì như code dưới đây. Tức đọc dữ liệu 1 lần từ sheet vào mảng sau đó trong vòng FOR thì dò trong mảng thôi.

Mã:

Function VH(ByVal tmp As Range, ByVal Rng As Range, ByVal RngTT As Range) As Variant Dim Dic As Object, DicTT As Object, Res(), sArr(), aRngTT(), aRng(), S As Variant, key Dim i As Long, k As Long sArr = tmp.Value aRng = Rng.Value aRngTT = RngTT.Value ReDim Res(LBound(sArr) To UBound(sArr), 1 To 1) Set Dic = CreateObject("Scripting.Dictionary") For i = 1 To UBound(aRng) key = aRng(i, 1) If Len(key) Then Dic.Item(LCase(key)) = aRng(i, 2) Next i Set DicTT = CreateObject("Scripting.Dictionary") For i = 1 To UBound(aRngTT) key = aRngTT(i, 1) If Len(key) Then DicTT.Item(LCase(key)) = aRngTT(i, 2) Next i For k = LBound(sArr) To UBound(sArr) If Len(sArr(k, 1)) Then S = Split(Application.Trim(sArr(k, 1)), " ") For i = LBound(S) To UBound(S) key = LCase(S(i)) If DicTT.exists(key) Then S(i) = DicTT.Item(key) Else If Dic.exists(key) Then S(i) = Dic.Item(key) End If Next i Res(k, 1) = Join(S, " ") End If Next VH = Res Set Dic = Nothing: Set DicTT = Nothing End Function

Function VH(ByVal tmp As Range, ByVal Rng As Range, ByVal RngTT As Range) As Variant
Với ByVal tmp As Range thì phạm vi áp dụng của Function bị hạn chế, khó dùng cho file thực tế của chủ topic
Thật ra File thực tế bảng tra không lớn nên dùng Range hay Array không ảnh hưởng bao nhiêu, chạy không mượt chủ yếu là do các hàm mảng khác và cách vận dụng công thức không phù hợp: https://www.giaiphapexcel.com/diendan/threads/nhờ-giúp-chuyển-công-thức-dài-thành-vba.134507/

HieuCD · 14/5/18

truongvu317 đã viết:
Like anh luôn! duyệt từng ô sẽ rất là chậm.

Nói là công thức mảng cho nó sang cái miệng, chứ nó cũng như bao hàm khác thôi, chỉ là nó trả về mảng thay vì một giá trị, bạn làm cái này suốt rồi sao lại hỏi tui chứ, hishis hí hsis

Vậy là bạn không biết gì về công thức mảng? Hình người đẹp có bị gì không sao mờ quá vậy

batman1 · 14/5/18

HieuCD đã viết:
Function VH(ByVal tmp As Range, ByVal Rng As Range, ByVal RngTT As Range) As Variant
Với ByVal tmp As Range thì phạm vi áp dụng của Function bị hạn chế,

Suốt một thời gian dài tôi không tham gia chủ đề này vì một lý do đơn giản. Chủ chủ đề không đính kèm tập tin, không mô tả dữ liệu và không mô tả yêu cầu. Tôi hiểu là đã có chủ đề nào đó trước kia và chỉ những người tham gia nó mới hiểu.

Tôi chỉ sửa một code cụ thể, không xét nó trong bối cảnh tập tin của thớt. Vì làm gì có tập tin, làm gì có mô tả, yêu cầu? Còn kiểu dữ liệu nếu không đúng ý thì tự sửa. Thực ra tôi chỉ cần viết "đọc dữ liệu 1 lần từ sheet vào mảng sau đó trong vòng FOR thì dò trong mảng thôi." rồi mỗi người tự sửa thôi.

khó dùng cho file thực tế của chủ topic
Thật ra File thực tế bảng tra không lớn nên dùng Range hay Array không ảnh hưởng bao nhiêu, chạy không mượt chủ yếu là do các hàm mảng khác và cách vận dụng công thức không phù hợp

Tôi đâu biết dữ liệu lớn cỡ nào? Làm gì có tập tin, làm gì có mô tả, yêu cầu? Tôi chỉ thấy thớt kêu là chậm và thấy tập tin của bạn cỡ ~172000 dòng thôi. Với dữ liệu cỡ này thì code mới trên máy tôi chạy nhanh hơn cũ 4 lần. Tôi chạy thử trong tập tin của bạn mà trong đó có hàm mảng nào khác đâu?

Mà tôi cũng đã viết

Nên nhớ là khi dữ liệu lớn thì cấm tuyệt đối đọc (ghi) từng cell từ (vào) sheet

Tức chỉ khi dữ liệu khủng thì mới cần để ý. Nói thế không có nghĩa là cấm đọc từ sheet khi dữ liệu ít.

Tôi viết điều này cho thớt một phần thì cho những người khác hiện thời và trong tương lai 10 phần. Vì theo cách hoạt động của diễn đàn thì một người hỏi thì 1000 người được nhờ. Một câu trả lời là giúp cho 1001 người chứ không chỉ cho một mình thớt. Chỉ có ý thế thôi.

truongvu317 · 14/5/18

HieuCD đã viết:
Vậy là bạn không biết gì về công thức mảng? Hình người đẹp có bị gì không sao mờ quá vậy

Tự hiểu đi,tui có thấy file của chủ thớt đâu, sao nghe nhàm thế, vậy mà bạn viết code cứ như đúng rồi, phục quá. Còn avata của tui thì tui thích cái nào tui dùng cái ý, bạn có ý kiến gì không?

maiban116 · 14/5/18

batman1 đã viết:
Chậm là đương nhiên.

Mã:

For i = 1 To Rng.Rows.Count key = Rng(i, 1).Value If Len(key) Then Dic.Item(LCase(key)) = Rng(i, 2).Value Next i

Code trong vòng lặp trên đọc giá trị của từng ô từ sheet. Tổng cộng đọc 172000 lần vào key và đọc 171972 lần để thêm vào Dic. Vấn đề tương tự với vòng FOR thứ 2.

Nên nhớ là khi dữ liệu lớn thì cấm tuyệt đối đọc (ghi) từng cell từ (vào) sheet

Tôi chỉ sửa những chỗ "nhạy cảm".

Chú ý: tôi lấy code từ 1 bài trước, sau đó thấy có code mới nhưng ngại dò xem có chỗ nào thay đổi. Nói chung triết lý thì như code dưới đây. Tức đọc dữ liệu 1 lần từ sheet vào mảng sau đó trong vòng FOR thì dò trong mảng thôi.

Mã:

Function VH(ByVal tmp As Range, ByVal Rng As Range, ByVal RngTT As Range) As Variant Dim Dic As Object, DicTT As Object, Res(), sArr(), aRngTT(), aRng(), S As Variant, key Dim i As Long, k As Long sArr = tmp.Value aRng = Rng.Value aRngTT = RngTT.Value ReDim Res(LBound(sArr) To UBound(sArr), 1 To 1) Set Dic = CreateObject("Scripting.Dictionary") For i = 1 To UBound(aRng) key = aRng(i, 1) If Len(key) Then Dic.Item(LCase(key)) = aRng(i, 2) Next i Set DicTT = CreateObject("Scripting.Dictionary") For i = 1 To UBound(aRngTT) key = aRngTT(i, 1) If Len(key) Then DicTT.Item(LCase(key)) = aRngTT(i, 2) Next i For k = LBound(sArr) To UBound(sArr) If Len(sArr(k, 1)) Then S = Split(Application.Trim(sArr(k, 1)), " ") For i = LBound(S) To UBound(S) key = LCase(S(i)) If DicTT.exists(key) Then S(i) = DicTT.Item(key) Else If Dic.exists(key) Then S(i) = Dic.Item(key) End If Next i Res(k, 1) = Join(S, " ") End If Next VH = Res Set Dic = Nothing: Set DicTT = Nothing End Function

hàm này không tra được kiểu này: vh("

batman1 đã viết:
Chậm là đương nhiên.

Mã:

For i = 1 To Rng.Rows.Count key = Rng(i, 1).Value If Len(key) Then Dic.Item(LCase(key)) = Rng(i, 2).Value Next i

Code trong vòng lặp trên đọc giá trị của từng ô từ sheet. Tổng cộng đọc 172000 lần vào key và đọc 171972 lần để thêm vào Dic. Vấn đề tương tự với vòng FOR thứ 2.

Nên nhớ là khi dữ liệu lớn thì cấm tuyệt đối đọc (ghi) từng cell từ (vào) sheet

Tôi chỉ sửa những chỗ "nhạy cảm".

Chú ý: tôi lấy code từ 1 bài trước, sau đó thấy có code mới nhưng ngại dò xem có chỗ nào thay đổi. Nói chung triết lý thì như code dưới đây. Tức đọc dữ liệu 1 lần từ sheet vào mảng sau đó trong vòng FOR thì dò trong mảng thôi.

Mã:

Function VH(ByVal tmp As Range, ByVal Rng As Range, ByVal RngTT As Range) As Variant Dim Dic As Object, DicTT As Object, Res(), sArr(), aRngTT(), aRng(), S As Variant, key Dim i As Long, k As Long sArr = tmp.Value aRng = Rng.Value aRngTT = RngTT.Value ReDim Res(LBound(sArr) To UBound(sArr), 1 To 1) Set Dic = CreateObject("Scripting.Dictionary") For i = 1 To UBound(aRng) key = aRng(i, 1) If Len(key) Then Dic.Item(LCase(key)) = aRng(i, 2) Next i Set DicTT = CreateObject("Scripting.Dictionary") For i = 1 To UBound(aRngTT) key = aRngTT(i, 1) If Len(key) Then DicTT.Item(LCase(key)) = aRngTT(i, 2) Next i For k = LBound(sArr) To UBound(sArr) If Len(sArr(k, 1)) Then S = Split(Application.Trim(sArr(k, 1)), " ") For i = LBound(S) To UBound(S) key = LCase(S(i)) If DicTT.exists(key) Then S(i) = DicTT.Item(key) Else If Dic.exists(key) Then S(i) = Dic.Item(key) End If Next i Res(k, 1) = Join(S, " ") End If Next VH = Res Set Dic = Nothing: Set DicTT = Nothing End Function

Bạn batman1 cho mình hỏi cái code bạn sửa không tra được số théo ý mình ví dụ: mình cần tra số 105/16 nếu không có thì nó sẽ trả về là 105/16 thì mới đúng nhưng đây lại trả về 15/16. bạn xem lại hộ mình với. xin cảm ơn rất nhều

batman1 · 14/5/18

maiban116 đã viết:
hàm này không tra được kiểu này: vh("

Bạn batman1 cho mình hỏi cái code bạn sửa không tra được số théo ý mình ví dụ: mình cần tra số 105/16 nếu không có thì nó sẽ trả về là 105/16 thì mới đúng nhưng đây lại trả về 15/16. bạn xem lại hộ mình với. xin cảm ơn rất nhều

Đây không phải code của tôi. Tôi chỉ sửa code cho tốc độ nhanh hơn thôi.

Không phải là code trước khi sửa thì "chạy theo ý" còn sau khi sửa thì "chạy không như ý". Nếu code chạy không như ý thì là ngay từ đầu đã không như ý. Bạn hỏi bạn HieuCD điều này nhé. Vì tôi không tham gia những chủ đề trước của bạn nên chịu không biết nội dung của nó thế nào.

maiban116 · 15/5/18

maiban116 đã viết:
bác HieuCD ơi chạy còn chậm hơn bản gốc của bác, hơn nữa xóa cột G:H đi nó không tra ở cột E:F

cái nay của Bạn HieuCD vẫn ok mà do bạn sửa lại cái code khi nó không tra được thì nó trả về giá trị rò

batman1 · 15/5/18

maiban116 đã viết:
cái nay của Bạn HieuCD vẫn ok mà do bạn sửa lại cái code khi nó không tra được thì nó trả về giá trị rò

Nếu bạn đã nói thế thì đính kèm tập tin với code, và nói sau khi chạy thì chỗ nào, cái gì có vấn đề. Với tôi bạn không thể chơi trò nói suông được. Phải có tập tin mới bàn luận được.

truongvu317 · 15/5/18

batman1 đã viết:
Nếu bạn đã nói thế thì đính kèm tập tin với code, và nói sau khi chạy thì chỗ nào, cái gì có vấn đề. Với tôi bạn không thể chơi trò nói suông được. Phải có tập tin mới bàn luận được.

Chúc mừng thớt nhé, sau một hồi lòng vòng thớt mới khởi động xong. và giớ mới là vào vạch xuất phát. mà có up file thì up luôn file thât nhá, không chơi mô phỏng. " sao tui nghe như trong lòng chơi vơi..." toàn bộ code và công sức ở phía trên bỏ xó cả rồi.

Nhờ các bạn sửa hộ code cho mượt hơn (1 người xem)

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

Thành viên thường trực

Thành viên tiêu biểu

Thành viên thường trực

Thành viên tiêu biểu

Thành viên tiêu biểu

File đính kèm

Thành viên thường trực

Thành viên tiêu biểu

Thành viên tiêu biểu

==(^o^)==

Thành viên tiêu biểu

File đính kèm

Thành viên tiêu biểu

Thành viên thường trực

Chuyên gia GPE

Thành viên tiêu biểu

Chuyên gia GPE

Chuyên gia GPE

Thành viên thường trực

Thành viên thường trực

Chuyên gia GPE

File đính kèm

Thành viên thường trực

Thành viên tiêu biểu

Thành viên tiêu biểu

File đính kèm

Chuyên gia GPE

File đính kèm

Thành viên thường trực

Chuyên gia GPE

Thành viên thường trực

Chuyên gia GPE

Chuyên gia GPE

Thành viên thường trực

Chuyên gia GPE

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên tiêu biểu

Đang đi tìm hòn đá

Thành viên tích cực

Chuyên gia GPE

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

Thành viên thường trực

Thành viên tích cực

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

Chuyên gia GPE

Chuyên gia GPE

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

Thành viên tích cực

Thành viên thường trực

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

Thành viên thường trực

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

Thành viên tích cực

Thời gian đếm ngược.