Nhờ các bạn sửa hộ code cho mượt hơn (3 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

Nhờ các bạn sửa hộ code cho mượt hơn (3 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

Đếm ngược thời gian