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

[maiban116]

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

 

[♫ђöล♥ßล†♥†µ♫]

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]

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ộ

 

[♫ђöล♥ßล†♥†µ♫]

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ứ

 

[♫ђöล♥ßล†♥†µ♫]

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 đó

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]

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

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ỉ

 

[♫ђöล♥ßล†♥†µ♫]

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]

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]

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.

 

[♫ђöล♥ßล†♥†µ♫]

"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

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

 

[♫ђöล♥ßล†♥†µ♫]

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]

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]

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

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

 

[♫ђöล♥ßล†♥†µ♫]

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]

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

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]

Đầ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]

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]

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

 

[HieuCD]

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]

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