Xin giúp đỡ đổi "Function" thành "Sub" (1 người xem)

Cô Bé Dễ Thương · 31/1/21

Bài toán như sau:
Ví dụ:
39014
2915
106
16
7
- Lần lượt lấy 3+9, rồi lấy 9+0, tiếp 0+1, tiếp 1+4.Nếu lớn 10 thì chỉ lấy hàng đơn vị. Được số mới là: 2915
- Và lại liên tiếp 2+9=11 lấy hàng đơn vị được 1, tiếp 9+1=10 lấy 0,tiếp 1+5=6.Ta được số mới: 106
- Tiếp tục: 1+0=1, 0+6=6 Được số mớ là 16
- Tiếp tục: 1+6=7

Được sự giúp đỡ của bác haonlh có Function (kết quả ok),như sau:
Chép hàm sau vào code của bảng tính
Function SPascal(ss$) As Long
' Tinh tong pascal
Dim lenth&, i&, tam$, s1$, s2$
lenth = Len(ss)
Do While lenth > 1
tam = "":

s1 = Left(ss, 1)
For i = 2 To lenth
s2 = Mid(ss, i, 1)
tam = tam & ((Val(s1) + Val(s2)) Mod 10)
s1 = s2
Next
ss = tam
lenth = Len(ss)
Loop
SPascal = ss
End Function
Chú ý đối số trên ô nào đó phải không quá 15 chữ số. Còn nếu hơn thì phải định dạng ô đó là text (hoặc gõ dấu nháy đơn rồi nhập số).

Nay em muốn đổi chương trình này thành Sub. Các anh chị giúp em với. Vốn VBA của em hiện chưa đủ để viết lai chương trình này.
Vậy xin các anh chị có ghé qua đổi Function trên thành Sub giúp em với ạ.
Em cảm ơn chân thành!

VetMini · 31/1/21

Function thì nó có cái kết qủa để trả về. Đổi thành Sub thì kết quả bỏ vào đâu?

Cô Bé Dễ Thương · 31/1/21

VetMini đã viết:
Function thì nó có cái kết qủa để trả về. Đổi thành Sub thì kết quả bỏ vào đâu?

Bỏ vào A1 chẳng hạn. Ô nào cũng đươc ạ. Bác đổi giúp em với

Maika8008 · 31/1/21

kompagtvt đã viết:
Bỏ vào A1 chẳng hạn. Ô nào cũng đươc ạ. Bác đổi giúp em với

A1 là ô chứa con số gốc VD: 39014
A2 là ô kết quả

Rich (BB code):

Sub SPascal1()
' Tinh tong pascal
Dim lenth&, i&, tam$, s1$, s2$
Dim ss$
ss = Range("B1")
lenth = Len(ss)
Do While lenth > 1
    tam = "": s1 = Left(ss, 1)
    For i = 2 To lenth
        s2 = Mid(ss, i, 1)
        tam = tam & ((Val(s1) + Val(s2)) Mod 10)
        s1 = s2
    Next
    ss = tam
    lenth = Len(ss)
Loop
Range("A1") = ss
End Sub

VetMini · 31/1/21

Maika8008 đã viết:
A1 là ô chứa con số gốc VD: 39014
A2 là ô kết quả

Rich (BB code):

Sub SPascal1() ' Tinh tong pascal Dim lenth&, i&, tam$, s1$, s2$ Dim ss$ ss = Range("B1") lenth = Len(ss) Do While lenth > 1 tam = "": s1 = Left(ss, 1) For i = 2 To lenth s2 = Mid(ss, i, 1) tam = tam & ((Val(s1) + Val(s2)) Mod 10) s1 = s2 Next ss = tam lenth = Len(ss) Loop Range("A1") = ss End Sub

Code chả cải tiến gì thì sửa lại chi vậy?
Chỉ cần đại khái:
Sub DoiTuFunction()
[a2].Value = SPascal([a1].Value)
End Sub

Chú về code: đáng lẽ bài này nên code hàm đệ quy.

Maika8008 · 31/1/21

VetMini đã viết:
Code chả cải tiến gì thì sửa lại chi vậy?
Chỉ cần đại khái:
Sub DoiTuFunction()
[a2].Value = SPascal([a1].Value)
End Sub

Chú về code: đáng lẽ bài này nên code hàm đệ quy.

Bác vội trách! Vì người ta không biết nên phải từng bước. Tôi hồi xưa còn không phân biệt được function và sub khác nhau thế nào mà. Nếu thay Function bằng Sub đâu có biết được ngay là làm thế nào để cho nó hoạt động được.

VetMini · 31/1/21

Maika8008 đã viết:
Bác vội trách! Vì người ta không biết nên phải từng bước. Tôi hồi xưa còn không phân biệt được function và sub khác nhau thế nào mà. Nếu thay Function bằng Sub đâu có biết được ngay là làm thế nào để cho nó hoạt động được.

Tại bạn học đốt mất giai đoạn căn bản của hàm con (nói chung cho function và sub). Bạn không thể nói "từng bước" được vì chính bạn đã từng bỏ mất vài bước ở giữa.
Và phần căn bản của hàm con cũng khuyên rằng (*): nếu đã có một hàm con chạy ra kết quả rồi thì cần thêm thắt gì cứ việc vết thêm cái hàm/sub gọi nó. Cực chẳng đã mới phải sửa.

(*) chính sách "chia để trị" của viết code:
Hầu hết các vị viết code ở đây có khuynh hướng viết một cái hàm/sub tổ bố với một đống options làm đủ thứ việc.
Tôi theo chính sách khác: viết nhiều hàm con; mỗi hàm con có công việc riêng của nó. Cái hàm/sub chung với một đống options gọi những hàm nhỏ này.

(**) Thêm, hàm đệ quy:
Function PatCanDom(so As String) As String
' hàm đệ quy tính trị Pascal của một chuỗi số
If Len(so) <= 1 Then
PatCanDom = so
Exit Function
End If
Dim i As Long, s As String
For i = 1 To Len(so) - 1
s = s & ((Val(Mid(so, i, 1)) + Val(Mid(so, i + 1, 1))) Mod 10) ' chỉ lấy 1 chữ số hàng đơn vị
Next i
PatCanDom = PatCanDom(s)
End Function

batman1 · 1/2/21

Thực ra đệ qui không phải toàn mầu hồng, không phải bao giờ cũng tốt.

Đệ qui cho phép giải quyết nhiều vấn đề theo cách dễ dàng hơn so với những cách "truyền thống". Nhưng có những tình huống không nên sử dụng đệ qui, thậm chí cả khi thuật toán dùng đệ qui có vẻ như đơn giản hơn.

Nên nhớ về các mặt xấu của đệ qui:
- cần nhiều bộ nhớ (memory) trong quá trình tính toán. Cứ mỗi lần gọi đệ qui là một lần phải nhớ một số thông tin (đặt lên stack), cần thiết cho việc tái tạo lại tình trạng trước khi gọi đệ qui (khi return thì lấy lại từ stack). Máy vi tính đôi khi gặp nhiều khó khăn khi tính giá trị của hàm, mặc dù các tham số không hề lớn. Vd. điển hình là tính phần tử thứ n (n = 1, 2, ...) của dãy Fibonacci.

- nhiều khi chương trình dùng đệ qui chạy chậm hơn so với chương trình dùng vòng lặp.

Nếu thuật toán không dùng đệ qui sẽ phức tạp hơn nhiều so với thuật toán dùng đệ qui thì người ta dùng đệ qui. Trong trường hợp ngược lại thì người ta dùng thuật toán không dùng đệ qui.
-----------
1. Ta xét 2 code: dùng và không dùng đệ quy.

Mã:

Function Fibo_dequi(ByVal n As Long) As Double
    If n > 2 Then
        Fibo_dequi = Fibo_dequi(n - 2) + Fibo_dequi(n - 1)
    ElseIf n > 0 Then
        Fibo_dequi = n - 1
    End If
End Function

Function Fibo(ByVal n As Long) As Double
Dim k As Long, f As Double, f1 As Double, f2 As Double
    If n < 3 Then
        If n >= 1 Then Fibo = n - 1
        Exit Function
    End If
    f1 = 0
    f2 = 1
    For k = 1 To n
        If k > 2 Then
            f = f1 + f2
            f1 = f2
            f2 = f
        Else
            f = k - 1
        End If
    Next k
    Fibo = f
End Function

Sub test1()
Dim n As Long, t
    t = Timer
    n = 70
    Debug.Print Fibo(n)
    MsgBox "Fibo: " & Timer - t
End Sub

Sub test2()
Dim n As Long, t
    t = Timer
    n = 70
    Debug.Print Fibo_dequi(n)
    MsgBox "Fibo_dequi: " & Timer - t
End Sub

Sub test1 chạy trong nháy mắt trong khi test2 tôi phải dùng Task Manager để giết

2.

Mã:

Function tong_chuso(ByVal so As String) As Long
Dim length As Long, k As Long, tmp As String, s1 As Long, s2 As Long
    length = Len(so)
    Do While length > 1
        tmp = String(length - 1, "0")
        s1 = Left(so, 1)
        For k = 2 To length
            s2 = Mid(so, k, 1)
            Mid(tmp, k - 1, 1) = (s1 + s2) Mod 10
            s1 = s2
        Next
        so = tmp
        length = Len(so)
    Loop
    tong_chuso = so
End Function

Sub batman1()
Dim s As String, t
    t = Timer
    s = "aaaaaaaaaaaaaaaaaaaa"
    s = Replace(s, "a", "bbbbbbbbbbbbbbbbbbbb")
    s = Replace(s, "b", "12345678901234567895")
   
    MsgBox "batman1: " & tong_chuso(s) & " - " & Timer - t
End Sub

Trên máy tôi sub batman1 chạy hết khoảng 35 s. Code dùng đệ qui chạy bị lỗi tràn bộ nhớ (tràn stack).
Nếu rút ngắn chuỗi s thì code dùng đệ qui không còn lỗi nữa nhưng chạy chậm hơn code không dùng đệ qui.

HieuCD · 1/2/21

batman1 đã viết:
Thực ra đệ qui không phải toàn mầu hồng, không phải bao giờ cũng tốt.

Đệ qui cho phép giải quyết nhiều vấn đề theo cách dễ dàng hơn so với những cách "truyền thống". Nhưng có những tình huống không nên sử dụng đệ qui, thậm chí cả khi thuật toán dùng đệ qui có vẻ như đơn giản hơn.

Nên nhớ về các mặt xấu của đệ qui:
- cần nhiều bộ nhớ (memory) trong quá trình tính toán. Cứ mỗi lần gọi đệ qui là một lần phải nhớ một số thông tin (đặt lên stack), cần thiết cho việc tái tạo lại tình trạng trước khi gọi đệ qui (khi return thì lấy lại từ stack). Máy vi tính đôi khi gặp nhiều khó khăn khi tính giá trị của hàm, mặc dù các tham số không hề lớn. Vd. điển hình là tính phần tử thứ n (n = 1, 2, ...) của dãy Fibonacci.

- nhiều khi chương trình dùng đệ qui chạy chậm hơn so với chương trình dùng vòng lặp.

Nếu thuật toán không dùng đệ qui sẽ phức tạp hơn nhiều so với thuật toán dùng đệ qui thì người ta dùng đệ qui. Trong trường hợp ngược lại thì người ta dùng thuật toán không dùng đệ qui.
-----------
1. Ta xét 2 code: dùng và không dùng đệ quy.

Mã:

Function Fibo_dequi(ByVal n As Long) As Double If n > 2 Then Fibo_dequi = Fibo_dequi(n - 2) + Fibo_dequi(n - 1) ElseIf n > 0 Then Fibo_dequi = n - 1 End If End Function Function Fibo(ByVal n As Long) As Double Dim k As Long, f As Double, f1 As Double, f2 As Double If n < 3 Then If n >= 1 Then Fibo = n - 1 Exit Function End If f1 = 0 f2 = 1 For k = 1 To n If k > 2 Then f = f1 + f2 f1 = f2 f2 = f Else f = k - 1 End If Next k Fibo = f End Function Sub test1() Dim n As Long, t t = Timer n = 70 Debug.Print Fibo(n) MsgBox "Fibo: " & Timer - t End Sub Sub test2() Dim n As Long, t t = Timer n = 70 Debug.Print Fibo_dequi(n) MsgBox "Fibo_dequi: " & Timer - t End Sub

Sub test1 chạy trong nháy mắt trong khi test2 tôi phải dùng Task Manager để giết

2.

Mã:

Function tong_chuso(ByVal so As String) As Long Dim length As Long, k As Long, tmp As String, s1 As Long, s2 As Long length = Len(so) Do While length > 1 tmp = String(length - 1, "0") s1 = Left(so, 1) For k = 2 To length s2 = Mid(so, k, 1) Mid(tmp, k - 1, 1) = (s1 + s2) Mod 10 s1 = s2 Next so = tmp length = Len(so) Loop tong_chuso = so End Function Sub batman1() Dim s As String, t t = Timer s = "aaaaaaaaaaaaaaaaaaaa" s = Replace(s, "a", "bbbbbbbbbbbbbbbbbbbb") s = Replace(s, "b", "12345678901234567895") MsgBox "batman1: " & tong_chuso(s) & " - " & Timer - t End Sub

Trên máy tôi sub batman1 chạy hết khoảng 35 s. Code dùng đệ qui chạy bị lỗi tràn bộ nhớ (tràn stack).
Nếu rút ngắn chuỗi s thì code dùng đệ qui không còn lỗi nữa nhưng chạy chậm hơn code không dùng đệ qui.

Code đệ qui chạy chậm do cách xử lý không hợp lý khiến số lần gọi lại hàm quá lớn, vấn đề ở lệnh
Fibo_dequi = Fibo_dequi(n - 2) + Fibo_dequi(n - 1)
Trong khi đó code dùng for chỉ chạy n lần vòng
Nếu theo dạng
Fibo_dequi = Fibo_dequi(...)
Tốc độ sẽ khác nhiều

Thử chạy sub Test với cột đầu mảng Res là số lần gọi Function Fibo_dequi

Mã:

Dim q

Sub Test()
  Dim tmp, i&, n&, Res() As Long
 
  n = 20
  ReDim Res(1 To n, 1 To 2)
  For i = 1 To n
    q = 0
    Res(i, 2) = Fibo_dequi(i)
    Res(i, 1) = q
  Next i
  Range("A2").Resize(n, 2) = Res
End Sub

Function Fibo_dequi(ByVal n As Long) As Double
    q = q + 1
    If n > 2 Then
        Fibo_dequi = Fibo_dequi(n - 2) + Fibo_dequi(n - 1)
    ElseIf n > 0 Then
        Fibo_dequi = n - 1
    End If
End Function

VetMini · 1/2/21

batman1 đã viết:
Thực ra đệ qui không phải toàn mầu hồng, không phải bao giờ cũng tốt.
...

Bài Pát Can này là bài nhỏ. Tôi chỉ nhân những lúc bài nhỏ để giới thiệu đệ quy thôi.

Chứ theo nguyên tắc "if it ain't broke, don't fix it" thì ở bài #5 tôi đã giải rồi:
Cái hàm của thớt đâu có vấn đề gì. Muốn dùng sub (chả biết để làm gì, để có thể nhấn nút?) thì chỉ việc viết cái sub gọi nó.

HieuCD đã viết:
Code đệ qui chạy chậm do cách xử lý không hợp lý khiến số lần gọi lại hàm quá lớn, ...

Đệ quy gần như không bao giờ được coi là code có tốc độ.
So với lối cổ điển vòng lặp, đệ quy gần như luôn phải chịu gánh nặng "gọi và nối hàm".
Mỗi lượt gọi và nối hàm lại phải tốn thì giờ và bộ nhớ ngăn xếp.

HieuCD · 1/2/21

VetMini đã viết:
Bài Pát Can này là bài nhỏ. Tôi chỉ nhân những lúc bài nhỏ để giới thiệu đệ quy thôi.

Chứ theo nguyên tắc "if it ain't broke, don't fix it" thì ở bài #5 tôi đã giải rồi:
Cái hàm của thớt đâu có vấn đề gì. Muốn dùng sub (chả biết để làm gì, để có thể nhấn nút?) thì chỉ việc viết cái sub gọi nó.

Đệ quy gần như không bao giờ được coi là code có tốc độ.
So với lối cổ điển vòng lặp, đệ quy gần như luôn phải chịu gánh nặng "gọi và nối hàm".
Mỗi lượt gọi và nối hàm lại phải tốn thì giờ và bộ nhớ ngăn xếp.

Dùng Sub đệ quy tốc độ nhanh hơn Functio đệ quy

Mã:

Sub Main()
  Dim i&, n&, Res#, Arr()

  n = 1000
  ReDim Arr(1 To n, 1 To 1)
  For i = 1 To n
    Res = 1
    Call DeQui(Res, 0, i)
    Arr(i, 1) = Res
  Next i
  Range("C2").Resize(n, 1) = Arr
End Sub

Private Sub DeQui(ByRef Res, ByVal Res0#, ByVal n&)
  Dim tmp#

  If n > 2 Then
    tmp = Res
    Res = Res + Res0
    Call DeQui(Res, tmp, n - 1)
  ElseIf n > 0 Then
    If Res = 1 Then Res = n - 1
  End If
End Sub

Cô Bé Dễ Thương · 1/2/21

VetMini cảm ơn anh nhiều. cách của anh giúp nhiều bạn cứng vba chuyển function sang Sud dễ dàng

Maika8008 cảm ơn anh. đã không tiếc thời gian viết lại cho em thành Sub. Giúp em hiểu thuật toán của function gốc

batman1 HieuCD cảm ơn các anh đã quan tâm

Hôm qua em thấy được comment của các bác rồi. Do trục trặc mạng không vào sớm để cảm ơn các bác được. Em chúc các bác mạnh khỏe.

VetMini · 1/2/21

HieuCD đã viết:
Dùng Sub đệ quy tốc độ nhanh hơn Functio đệ quy
...

Có nhiều yếu tố. Yếu tố quan trọng nhất là ngôn ngữ. Yếu tố thứ hai là cách giảm thiểu công việc nhét và móc ngăn xếp cho chương trình mỗi lượt gọi và kết thúc hàm. Điển hình, byRef nhanh hơn byVal, dùng biến toàn cục (nhất là mảng) để giảm bộ nhớ ngăn xếp, ...

Nó chuyện thêm về Code nhanh:

Bỏ qua cái nguyên tắc "if it ain't broke, don't fix it" (nếu nó chưa hư thì đừng vội sửa) thì code bài #1 rất luộm thuộm. Nó được viết thẳng theo yêu cầu mà không qua phân tích.
Vì vậy, code bị phải liên tục tính lại chuỗi số. Chuỗi mà bị tính lại rất tốn tài nguyên máy.

Theo luật cộng Pascal thì cứ mỗi lượt tính, lượng số đầu ra giảm đi 1 so với đầu vào.
Nếu có thiết kế đầy đủ thì lúc duyệt chuỗi chỉ cần 1 chuỗi và một biến cho biết độ dài hiện sử dụng trong chuỗi.

Mã:

Function PatCanXiCut(ByVal chuoi As String) As Long
' hàm xì cút tính trị pát can của một chuỗi số
If Len(chuoi) <= 1 Then
  PatCanXiCut = Val(chuoi)
  Exit Function
End If
Dim curLen As Long, i As Long, so1 As Long, so2 As Long
For curLen = Len(chuoi) To 2 Step -1
  so1 = Val(Mid(chuoi, 1, 1))
  For i = 2 To curLen
    so2 = Val(Mid(chuoi, i, 1))
    Mid(chuoi, i - 1, 1) = (so1 + so2) Mod 10
    so1 = so2
  Next i
Next curLen
PatCanXiCut = Val(Left(chuoi, 1))
End Function

Giải thutaaj trên vẫn chưa tối ưu vì phải ghi lại kêt quả tạm trong chuỗi số, rồi lại lấy ra để tính tiếp. Nếu chuỗi dài thì có lẽ dùng một mảng tạm hiệu quả hơn
Hiện tại tôi vẫn chưa tìm được cách tính thẳng luôn từ đầu đến cuối.

HieuCD · 1/2/21

VetMini đã viết:
Có nhiều yếu tố. Yếu tố quan trọng nhất là ngôn ngữ. Yếu tố thứ hai là cách giảm thiểu công việc nhét và móc ngăn xếp cho chương trình mỗi lượt gọi và kết thúc hàm. Điển hình, byRef nhanh hơn byVal, dùng biến toàn cục (nhất là mảng) để giảm bộ nhớ ngăn xếp, ...

Nó chuyện thêm về Code nhanh:

Bỏ qua cái nguyên tắc "if it ain't broke, don't fix it" (nếu nó chưa hư thì đừng vội sửa) thì code bài #1 rất luộm thuộm. Nó được viết thẳng theo yêu cầu mà không qua phân tích.
Vì vậy, code bị phải liên tục tính lại chuỗi số. Chuỗi mà bị tính lại rất tốn tài nguyên máy.

Theo luật cộng Pascal thì cứ mỗi lượt tính, lượng số đầu ra giảm đi 1 so với đầu vào.
Nếu có thiết kế đầy đủ thì lúc duyệt chuỗi chỉ cần 1 chuỗi và một biến cho biết độ dài hiện sử dụng trong chuỗi.

Mã:

Function PatCanXiCut(ByVal chuoi As String) As Long ' hàm xì cút tính trị pát can của một chuỗi số If Len(chuoi) <= 1 Then PatCanXiCut = Val(chuoi) Exit Function End If Dim curLen As Long, i As Long, so1 As Long, so2 As Long For curLen = Len(chuoi) To 2 Step -1 so1 = Val(Mid(chuoi, 1, 1)) For i = 2 To curLen so2 = Val(Mid(chuoi, i, 1)) Mid(chuoi, i - 1, 1) = (so1 + so2) Mod 10 so1 = so2 Next i Next curLen PatCanXiCut = Val(Left(chuoi, 1)) End Function

Giải thutaaj trên vẫn chưa tối ưu vì phải ghi lại kêt quả tạm trong chuỗi số, rồi lại lấy ra để tính tiếp. Nếu chuỗi dài thì có lẽ dùng một mảng tạm hiệu quả hơn
Hiện tại tôi vẫn chưa tìm được cách tính thẳng luôn từ đầu đến cuối.

Giải thuật và code quá hay, khó có cách nào viết hiệu quả hơn /-*+/

batman1 · 1/2/21

HieuCD đã viết:
Code đệ qui chạy chậm do cách xử lý không hợp lý khiến số lần gọi lại hàm quá lớn, vấn đề ở lệnh
Fibo_dequi = Fibo_dequi(n - 2) + Fibo_dequi(n - 1)
Trong khi đó code dùng for chỉ chạy n lần vòng
Nếu theo dạng
Fibo_dequi = Fibo_dequi(...)
Tốc độ sẽ khác nhiều

Thử chạy sub Test với cột đầu mảng Res là số lần gọi Function Fibo_dequi

Mã:

Dim q Sub Test() Dim tmp, i&, n&, Res() As Long n = 20 ReDim Res(1 To n, 1 To 2) For i = 1 To n q = 0 Res(i, 2) = Fibo_dequi(i) Res(i, 1) = q Next i Range("A2").Resize(n, 2) = Res End Sub Function Fibo_dequi(ByVal n As Long) As Double q = q + 1 If n > 2 Then Fibo_dequi = Fibo_dequi(n - 2) + Fibo_dequi(n - 1) ElseIf n > 0 Then Fibo_dequi = n - 1 End If End Function

Tôi không hiểu ý bạn.

Tôi muốn tính số Fibonacci vd. thứ 70. Tôi không quan tâm tới các số Fibonacci 1, 2, ..., 69, 71, 72, ... nhưng nếu code tính thêm thì cũng chả sao. Để tính số Fibonacci thứ 70 tôi chạy test1 và test2 ở bài #8. Kết quả là test1 chạy trong nháy mắt, còn test2 tôi phải giết vì đợi quá lâu.

Bạn đề nghị code trong bài #9. Bạn đã thử chạy code bài #9 với n = 70 chưa? Tôi không quan tâm tới n = 20 vì quá tầm thường. Với n = 70 bạn thử thấy code chạy hết bao lâu?

Ngô Hải Đăng · 1/2/21

Viết như vậy được không ta

PHP:

Function Pascal(iChuoi As String) As Long
  Dim x&
  For x = 1 To Len(iChuoi)
    Pascal = (Pascal + Val(Mid(iChuoi, x, 1))) Mod 10
  Next x
End Function

VetMini · 1/2/21

Ngô Hải Đăng đã viết:
Viết như vậy được không ta

PHP:

Function Pascal(iChuoi As String) As Long Dim x& For x = 1 To Len(iChuoi) Pascal = (Pascal + Val(Mid(iChuoi, x, 1))) Mod 10 Next x End Function

Cứ thử thì biết. Hỏi chi mất công.

batman1 · 1/2/21

HieuCD đã viết:
Dùng Sub đệ quy tốc độ nhanh hơn Functio đệ quy

Mọi nỗ lực hiện thời của bạn là cải thiện tốc độ cho đệ qui. Cái mà tôi muốn trình bầy là so sánh giữa đệ qui và KHÔNG đệ qui cho cùng một n.

1. Với function đệ qui thì dễ rồi. Đó là hàm tổng quát. Tôi có thể gửi cho người khác và họ chỉ cần biết chạy code là tính được số Fibonacci vd. thứ 70. Hoặc nếu họ cần code trong ngôn ngữ khác và họ biết lập trình thì họ chỉ cần dịch ra ngôn ngữ khác. Sub đệ qui khi gửi cho người không biết lập trình mà chỉ biết chạy code thì luôn phải đính kèm code kiểu Main. Vì nếu không có thì "em gà lắm" không biết viết THÊM code như thế nào để tính số Fibonacci vd. thứ 70.

Nhưng mục đích của tôi là so sánh đệ qui và KHÔNG đệ qui.

2. Khi chạy sub đệ qui ở bài #11 với n = 1400, và function KHÔNG đệ qui ở bài #8 cũng với n = 1400 thì code ở bài #8 chạy nhanh hơn.

Mục đích trong bài #8 là so sánh đệ qui và KHÔNG đệ qui trong một vấn đề cụ thể.

batman1 · 1/2/21

HieuCD đã viết:
Giải thuật và code quá hay, khó có cách nào viết hiệu quả hơn

Ngay ở bài #8 tôi đã đưa ra code hàm tong_chuso với code dùng để test là

Mã:

Sub batman1()
Dim s As String, t
    t = Timer
    s = "aaaaaaaaaaaaaaaaaaaa"
    s = Replace(s, "a", "bbbbbbbbbbbbbbbbbbbb")
    s = Replace(s, "b", "12345678901234567895")
    
    MsgBox "batman1: " & tong_chuso(s) & " - " & Timer - t
End Sub

Tôi chạy thử lại thì mất 37,75781 s trên máy tôi.

Tôi cũng chạy code test code PatCanXiCut

Mã:

Sub blabla()
Dim s As String, t
    t = Timer
    s = "aaaaaaaaaaaaaaaaaaaa"
    s = Replace(s, "a", "bbbbbbbbbbbbbbbbbbbb")
    s = Replace(s, "b", "12345678901234567895")
    
    MsgBox "PatCanXiCut: " & PatCanXiCut(s) & " - " & Timer - t
End Sub

Chạy thử mất 46,60156 s. Tôi không quan trọng sự chênh lệch vài giây vì đó có thể là sự dao động của system ở mỗi thời điểm. Nhưng tôi không tin là code ở bài #13 (PatCanXiCut) chạy nhanh vượt trội hơn code ở bài #8 (tong_chuso).

Tôi không phải là loại người thích thi thố tốc độ. Bàn về code, kể cả tốc độ của code thôi chứ không hay thi thố chuyện viết code ngắn nhất, dùng ít FOR, ít Do, chạy cực nhanh. Nhưng riêng bài này tôi muốn trình bầy thêm một code nữa. Chưa suy nghĩ sâu nhưng chắc không sai.

Mã:

Function tong_chuso(ByVal so As String) As Long
Dim length As Long, k As Long, start As Long, chuso() As Long
    length = Len(so)
    ReDim chuso(1 To length)
    For k = 1 To length
        chuso(k) = Mid(so, k, 1)
    Next k
    For k = 1 To length - 1
        For start = 1 To length - k
            chuso(start) = (chuso(start) + chuso(start + 1)) Mod 10
        Next start
    Next
    tong_chuso = chu

Code này có lẽ vô địch thế giới rồi.

VetMini · 1/2/21

batman1 đã viết:
Ngay ở bài #8 tôi đã đưa ra code hàm tong_chuso với code dùng để test là
...

tong_chuso dùng phép ép kiểu để đổi chuỗi thành số.
Các code khác dùng hàm Val. Có lẽ (đoán thôi) do hàm này là hàm "lấy số cho đến lúc hết lấy được" cho nên không hiệu quả lắm.
Tôi chỉ chưa hiểu tại sao code tong_chuso gọi hàm String để lập chuỗi (len-1) lần mà không bị mất hiệu quả. Có lẽ hàm String được viết rất tốt cho VBA?

batman1 · 1/2/21

VetMini đã viết:
tong_chuso dùng phép ép kiểu để đổi chuỗi thành số.
Các code khác dùng hàm Val. Có lẽ (đoán thôi) do hàm này là hàm "lấy số cho đến lúc hết lấy được" cho nên không hiệu quả lắm.
Tôi chỉ chưa hiểu tại sao code tong_chuso gọi hàm String để lập chuỗi (len-1) lần mà không bị mất hiệu quả. Có lẽ hàm String được viết rất tốt cho VBA?

Đúng là hàm ở bài #8 còn có thể tối ưu. Tức vẫn dùng chuỗi nhưng viết khác chút.

HieuCD · 2/2/21

batman1 đã viết:
Tôi không hiểu ý bạn.

Tôi muốn tính số Fibonacci vd. thứ 70. Tôi không quan tâm tới các số Fibonacci 1, 2, ..., 69, 71, 72, ... nhưng nếu code tính thêm thì cũng chả sao. Để tính số Fibonacci thứ 70 tôi chạy test1 và test2 ở bài #8. Kết quả là test1 chạy trong nháy mắt, còn test2 tôi phải giết vì đợi quá lâu.

Bạn đề nghị code trong bài #9. Bạn đã thử chạy code bài #9 với n = 70 chưa? Tôi không quan tâm tới n = 20 vì quá tầm thường. Với n = 70 bạn thử thấy code chạy hết bao lâu?

Với Function Fibo_dequi máy mình không dám thử với n=70 vì lệnh
Fibo_dequi = Fibo_dequi(n - 2) + Fibo_dequi(n - 1)
1 sẽ thành 2, 2 thành 4 và 8, 16 ... số lần xử lý tăng theo cấp số nhân, minh họa điển hình về cấp số nhân hầu như ai cũng biết bài toán nhà vua thưởng lúa cho người sáng tạo trò chơi cờ tướng (có thể là cờ vua)
Code bài #9 chỉ tính số lần gọi Fibo_dequi chứng tỏ số lần xử lý tăng nhanh hơn nhiều lần khi dùng vòng For. 2 ví dụ bài #8 cách thức xử lý khác nhau nên không thể chứng minh đệ quy chậm hơn nhiều lần so với vòng For
Private Sub DeQui(ByRef Res, ByVal Res0#, ByVal n&) bài #11 thay thế Function Fibo_dequi và tốc độ khác nhiều

batman1 · 2/2/21

HieuCD đã viết:
Với Function Fibo_dequi máy mình không dám thử với n=70 vì lệnh
Fibo_dequi = Fibo_dequi(n - 2) + Fibo_dequi(n - 1)
1 sẽ thành 2, 2 thành 4 và 8, 16 ... số lần xử lý tăng theo cấp số nhân, minh họa điển hình về cấp số nhân hầu như ai cũng biết bài toán nhà vua thưởng lúa cho người sáng tạo trò chơi cờ tướng (có thể là cờ vua)
Code bài #9 chỉ tính số lần gọi Fibo_dequi chứng tỏ số lần xử lý tăng nhanh hơn nhiều lần khi dùng vòng For.

Tôi viết bài chẳng qua là do bạn thôi.
Bạn viết bài #9 có vẻ như góp ý cho tôi, tôi tưởng bạn có code đệ qui siêu nhân nên thử với n = 70 xem thế nào. Hoá ra là bạn chẳng đề xuất được hàm đệ qui nào mà chạy tàm tạm được với n = 70. Tôi đã nói rõ rồi. Mục đích của tôi là so sánh code đệ qui và không đệ qui. Nếu code đệ qui mà chạy nhanh hơn hẳn code KHÔNG đệ qui thì mới có thể là một phản bác có giá trị. Tôi đang nói về khuyết điểm của đệ qui mà lị. Vậy tại sao bạn lại phàn nàn về cấp số nhân? Bạn viết đệ qui không có cấp số nhân, chạy nhanh, chạy không lỗi đi để phản bác cái gọi là KHÔNG đệ qui ưu việt hơn. Sao bạn không viết mà lại phàn nàn về code của tôi? Nếu bạn đề xuất code hiệu quả của mình thì đó mới là phản bác có giá trị.
Còn về Sub đệ qui thì tôi đã có ý kiến rồi. Ngoài những ý kiến đó ra tôi không cho là nó ưu việt hơn hàm KHÔNG đệ qui. Cùng lắm thì bằng.
Nếu bạn muốn bàn về đệ qui hay không đệ qui thì bạn cứ viết bài, góp thêm ý kiến của mình. Nhưng một khi bạn cố tình phản bác bài của tôi thì hãy viết code của mình, viết code đề nghị để test, và cho biết kết quả test thế nào. Đừng phàn nàn là tại sao code của tôi thế này hay thế khác. Hãy đề xuất code của mình và chỉ ra những ưu điểm vượt trội của nó. Nếu không chỉ ra được thì không nên phản bác bài của người khác.

2 ví dụ bài #8 cách thức xử lý khác nhau nên không thể chứng minh đệ quy chậm hơn nhiều lần so với vòng For

Thế sao bạn không đề xuất hàm đệ qui của mình để chỉ ra là nó nhanh hơn rất nhiều code KHÔNG đệ qui?

Private Sub DeQui(ByRef Res, ByVal Res0#, ByVal n&) bài #11 thay thế Function Fibo_dequi và tốc độ khác nhiều

Nhanh hơn nhưng chắc chắn không nhanh hơn VƯỢT TRỘI so với hàm KHÔNG đệ qui ở bài #8. Còn những cái mà tôi nói về SUB đệ qui thì tôi đã nói rồi.

Một lần nữa tôi nhắc lại quan điểm của mình. Không phải đệ qui luôn là mầu hồng. Không phải bao giờ đệ qui cũng tốt. Có những lúc PHẢI dùng đệ qui, có những lúc KHÔNG NÊN dùng đệ qui. Thế thôi.

VetMini · 2/2/21

Đúng ra thì tôi không nên dẫn "đệ quy" vào bài này.

Chủ đề nên bàn cãi hơn ở bài này là cách sử dụng khác nhau giữa Function và Sub. Và cách tách hàm con, thêm hàm mẹ,...

Cô Bé Dễ Thương · 2/2/21

Có ô A1 chứa giá trị :39014
Giải Pascal theo hình tháp:
- Lần lượt lấy 3+9, rồi lấy 9+0, tiếp 0+1, tiếp 1+4.Nếu lớn 10 thì chỉ lấy hàng đơn vị. Được số mới là: 2915
- Và lại liên tiếp 2+9=11 lấy hàng đơn vị được 1, tiếp 9+1=10 lấy 0,tiếp 1+5=6.Ta được số mới: 106
- Tiếp tục: 1+0=1, 0+6=6 Được số mớ là 16
- Tiếp tục: 1+6=7
Kết quả như sau:
39014
2915
106
16
7
Bằng các "Function" và "Sub" ở các bài trên đã giải 1 các triệt để.Phải nói là quá sảng khoái và phong phú. Quá ngưỡng mộ các anh trên diễn đàn.
Ở trên là giải theo hình tháp.Có 1 cách giải nữa là theo hàng ngang(tổng liên tiếp và tất nhiên cho kết quả khác).Cụ thể như sau:
3+9+0+1+4 = 17
1+7 = 8
Qua nay em học mót mà chưa viết được.Xin các anh chỉ cho một Sub mà ra kết quả là 8 ở ô A2.
Em chân thành cảm ơn!

ptm0412 · 2/2/21

kompagtvt đã viết:
Ở trên là giải theo hình tháp.Có 1 cách giải nữa là theo hàng ngang(tổng liên tiếp và tất nhiên cho kết quả khác).Cụ thể như sau:
3+9+0+1+4 = 17
1+7 = 8

Đệ quy đơn giản này không đến nỗi chậm

PHP:

Function TongSHang(ByVal Num) As Long
Dim Len1 As Long, Temp As Long
Len1 = Len(CStr(Num))
If Len1 = 1 Then TongSHang = Num: Exit Function
For i = 1 To Len1
    Temp = Temp + Mid(Num, i, 1)
Next
If Len(CStr(Temp)) > 1 Then
    TongSHang = TongSHang(Temp)
Else
    TongSHang = Temp
End If
End Function

Ghi chú: Số lớn hơn 15 con phải chuyển về dạng text bằng cách điền dấu nháy ' ở trước

VetMini · 2/2/21

ptm0412 đã viết:
Đệ quy đơn giản này không đến nỗi chậm

PHP:

Function TongSHang(ByVal Num) As Long Dim Len1 As Long, Temp As Long Len1 = Len(CStr(Num)) If Len1 = 1 Then TongSHang = Num: Exit Function For i = 1 To Len1 Temp = Temp + Mid(Num, i, 1) Next If Len(CStr(Temp)) > 1 Then TongSHang = TongSHang(Temp) Else TongSHang = Temp End If End Function

Ghi chú: Số lớn hơn 15 con phải chuyển về dạng text bằng cách điền dấu nháy ' ở trước

Code này lợi dụng đặc tính Variant để đối phó với dạng của tham số hàm.
Vì chuỗi đầu tiên khó thể dài hơn trăm triệu ký tự cho nên kể từ lượt thứ nhì có thể dùng Long mà không sợ tràn số.
Tuy đây là một xảo thuật chấp nhận được ở VBA nhưng với lý thuyết đệ quy thì nó không thuần chủng (tiếng nghề: thoroughbred)

batman1 · 2/2/21

Tôi nằm mơ thấy code như sau, nhưng không dám chắc là sẽ đúng.

Mã:

Function tong_ngang(ByVal so As String) As Double
Dim k As Long, result As Double
    If Len(so) = 0 Then Exit Function
    For k = 1 To Len(so)
        result = result + Mid(so, k, 1)
    Next k
    tong_ngang = ((result - 1) Mod 9) + 1
End Function

Có thể có rắc rối khi số có rất rất nhiều chữ số và result cực lớn. Nguyên nhân do dùng MOD (chưa nghĩ kỹ)

batman1 · 2/2/21

Nếu so có quãng tới 14 chữ số thì code chỉ là

Mã:

Function tong_ngang(ByVal so As String) As Double
Dim result As Double
    If Len(so) Then
        result = so
        tong_ngang = ((result - 1) Mod 9) + 1
    End If
End Function

Ngô Hải Đăng · 2/2/21

batman1 đã viết:
Có thể có rắc rối khi số có rất rất nhiều chữ số và result cực lớn. Nguyên nhân do dùng MOD (chưa nghĩ kỹ)

Nếu vậy thì trong vòng lặp thay bằng result = (result + Mid(so, k, 1) - 1) Mod 9 + 1
Bài Tổng ngang này em cũng đã nghĩ đến chuyện mod 9 nhưng chưa nghĩ được là sẽ trừ 1 rồi sau đó cộng 1 như anh.

batman1 · 2/2/21

Ngô Hải Đăng đã viết:
Nếu vậy thì trong vòng lặp thay bằng result = (result + Mid(so, k, 1) - 1) Mod 9 + 1
Bài Tổng ngang này em cũng đã nghĩ đến chuyện mod 9 nhưng chưa nghĩ được là sẽ trừ 1 rồi sau đó cộng 1 như anh.

Đấy là lý thuyết thôi. Thậm chí nếu có giới hạn thì tôi nghĩ là chỉ khi so có hàng trăm triệu chữ số. Nếu số có ít chữ số hơn thì khỏi lo. Tóm lại là yên tâm đủ dùng.
Mà nếu tôi nhớ không lầm thì hàm MOD trên sheet có giới hạn. Tôi không rõ MOD trong VBA có giới hạn không.

Cô Bé Dễ Thương · 2/2/21

ptm0412 đã viết:
Đệ quy đơn giản này không đến nỗi chậm

PHP:

Function TongSHang(ByVal Num) As Long Dim Len1 As Long, Temp As Long Len1 = Len(CStr(Num)) If Len1 = 1 Then TongSHang = Num: Exit Function For i = 1 To Len1 Temp = Temp + Mid(Num, i, 1) Next If Len(CStr(Temp)) > 1 Then TongSHang = TongSHang(Temp) Else TongSHang = Temp End If End Function

Ghi chú: Số lớn hơn 15 con phải chuyển về dạng text bằng cách điền dấu nháy ' ở trước

Dùng Sub của anh VetMini
Sub DoiTuFunction()
[a2].Value = SPascal([a1].Value)
End Sub
Kết hợp Function của anh ptm0412 batman1 thì được luôn.
Nhưng em muốn thành "Sub" giải Pascal theo hàng ngang để học xong cái bài Pascal này. Các anh có ghé quá giúp em với ạ.
Em chân thành cảm ơn!

ptm0412 · 2/2/21

Này thì chuyển Function thành Sub

PHP:

Sub TongNgang()
Dim Len1 As Long, Temp As Long, Num As String
Len1 = Len([A1])
If Len1 = 1 Then [B1] = Num: Exit Sub
Num = [A1]
Do
    Len1 = Len(Num)
    For i = 1 To Len1
        Temp = Temp + Mid(Num, i, 1)
    Next
    If Len(CStr(Temp)) > 1 Then
        Num = Temp: Temp = 0
    Else
        Exit Do
    End If
Loop
[B1] = Temp
End Sub

PHP:

Sub tong_ngang()
    'Code anh batman1'
Dim k As Long, result As Double, So As String
So = [A1].Value
    If Len(So) = 0 Then Exit Sub
    For k = 1 To Len(So)
        result = result + Mid(So, k, 1)
    Next k
    [C1] = ((result - 1) Mod 9) + 1
End Sub

VetMini · 3/2/21

ptm0412 đã viết:
Này thì chuyển Function thành Sub
...

Thớt cứ nói mãi cái chuyện "đổi function thành sub" mà luôn tảng lờ không cho biết mục đích của mình.
Phải rõ mục đích mới biết cách chuyển đổi.

Như tôi nhận xét lời tác giải bài #6, có những người học VBA đốt giai đoạn cho nên không nắm vững sự khác biệt giữa hai loại hàm con này.
Khác biệt như sau:

Nhiệm vụ và vận hành:
- Function trả về một trị. Để có thể trả về kết quả, Sub phải dùng tham byRef, hoặc dùng biến toàn cục, hoặc dùng cách ghi vào đâu đó mà không bị mất sau khi sub thoát.
- Vì có thể trả về một trị cho nên function có thể dùng làm đối tác trong biểu thức. Sub chỉ có thể làm đối tác trong một lệnh gọi sub.

Tầm vực:
- Sub không có tham số sẽ được VBE xếp vào danh sách macro; Function thì không xuất hiện trong danh sách macro.
- Sub không thể gọi thẳng trên bảng tính mà phải qua link vào macro.
- Đại khái Sub có hể coi như thủ tục trong class module và Function có thể coi như thuộc tính.

Trên căn bản sự khác biệt trên, dữ liệu mà thớt đưa ra không đủ để tiến hành công việc chuyển một Function thành Sub:
1. Cái function ban đầu có tham số. Thớt không hề cho biết qua Sub có còn nhận tham hay không?
2. Nếu không nhận tham thì có cần xuất hiện trong danh sách macro hay không?
Thực tế, nếu không cần nằm trong danh sách macro mà chỉ phải ghi kết quả vào ô nào đó thì Function cũng làm được, chả có lý do gì để đổi qua Sub.

ptm0412 · 3/2/21

VetMini đã viết:
Thớt cứ nói mãi cái chuyện "đổi function thành sub" mà luôn tảng lờ không cho biết mục đích của mình.

Thực ra, theo tôi cách học như của tác giả là học ngược. Người ta học viết thủ tục (Sub) trước, đến sub có tham số, rồi sau cùng mới đến Function, và yêu cầu thường là chuyển từ sub thành function chứ không phải thế này.

Cô Bé Dễ Thương · 3/2/21

Giờ em mới vào cảm ơn các thầy.Dịch covit đâm ra có nhiều thời gian mày mò.Mục đích em là học vba. Sau khi thấy chỉ dùng hàm excel mà kết hơp công thức mảng hay đơ và file nặng,có lẽ lên học vba chăng?
Em nghĩ như này giống như học nhạc guita cổ điển âý. Nghe những bản nhạc hay thì thích và nghiền lắm. Nhưng ngó vào bản nhạc lại ngất. Nhưng có 1 cách học là học truyền tay mà không cần biết nốt nhạc vẫn chơi được.Tuy vất vả nhưng thích bài nào cũng chơi được.Giờ mỗi thứ biết 1 tý mà động vào vba toàn toán là toán,cũng hãi thật.
Em thấy thớt nhiều view và được các cây cổ thụ trong diễn đàn có để ý đến. Em nghĩ là "truyền tay" được nhiều đấy ạ.Các vấn đề các thầy chia sẻ quả thật rất công phu.Các vấn đề được các thầy giải quyết quá thấu, quá xuất sắc. Sao lại vào tay các thầy nó lại đơn giản vậy?
Mỗi thứ em biết có 1 chút không đến nơi đến chốn các thầy có mắng thì nhưng vẫn chỉ cho em và các bạn nhé!
Giả như em không hỏi làm sao được các thầy chỉ cho(chủ đề phải gây được hứng thú).Thiên thư vạn quyển(vba) đọc cũng không chắt ra được cô đọng như bài của các thầy đâu!

VetMini · 3/2/21

Đã biết ví lập trình như đờn ghi ta thì cũng nên biết cách học cũng giống luôn.
Không ai có thể đọc và hỏi mà đờn ghi ta được cả - trừ phi là nhơn tài xuất chúng. Mà đã là nhơn tài xuất chúng thì đâu có lên đây hỏi.

Túm lại, học lập trình cũng giống như học đờn. Người giỏi hỏi 1 thực tập 3; người trung bình hỏi 1 thực tập 5; người kém hỏi 1 thực tập 10.

Chính tôi tự xếp mình giữa trung bình và kém. Tức tỷ lệ hỏi/thực tập là 1/7. Để đạt trình độ này tôi đã trải qua hằng ngàn giờ thực tập và hằng chục năm kinh nghiệm thực tế.

Cô Bé Dễ Thương · 3/2/21

VetMini đã viết:
Đã biết ví lập trình như đờn ghi ta thì cũng nên biết cách học cũng giống luôn.
Không ai có thể đọc và hỏi mà đờn ghi ta được cả - trừ phi là nhơn tài xuất chúng. Mà đã là nhơn tài xuất chúng thì đâu có lên đây hỏi.

Túm lại, học lập trình cũng giống như học đờn. Người giỏi hỏi 1 thực tập 3; người trung bình hỏi 1 thực tập 5; người kém hỏi 1 thực tập 10.

Chính tôi tự xếp mình giữa trung bình và kém. Tức tỷ lệ hỏi/thực tập là 1/7. Để đạt trình độ này tôi đã trải qua hằng ngàn giờ thực tập và hằng chục năm kinh nghiệm thực tế.

Vâng thầy!Chúng em cảm ơn thầy!

Cô Bé Dễ Thương · 19/2/21

- Cháu xin chào các chú các bác, thầy cô, anh chị và toàn thể các bạn!
- Cháu tìm được một Function tên "Tongtext"của chú @Ba Tê. Function này thật độc đáo.Nó tính được tổng các số có text.
Cháu(em) đã thử mày mò đổi qua dạng "Sub" nhưng không được, càng rối hơn.
Xin các chú các bác, thầy cô, anh chị giúp cháu(em) đổi Function này qua Sub với ạ!
(có kèm file đính kèm minh họa)
Public Function Tongtext(ByVal Rng As Range, Optional Txt As String = "*") As Double
Dim Cll As Range, Num As Double
For Each Cll In Rng
If Not IsNumeric(Cll.Value) Then
Num = Val(Replace(Left(Cll, InStr(Cll, " ") - 1), ",", "."))
Else
Num = Cll.Value
End If
If Cll.Value Like "*" & Txt & "*" Then
Tongtext = Tongtext + Num
End If
Next Cll
End Function

Ba Tê · 19/2/21

emgaimuarao đã viết:
- Cháu xin chào các chú các bác, thầy cô, anh chị và toàn thể các bạn!
- Cháu tìm được một Function tên "Tongtext"của chú @Ba Tê. Function này thật độc đáo.Nó tính được tổng các số có text.
Cháu(em) đã thử mày mò đổi qua dạng "Sub" nhưng không được, càng rối hơn.
Xin các chú các bác, thầy cô, anh chị giúp cháu(em) đổi Function này qua Sub với ạ!
(có kèm file đính kèm minh họa)
Public Function Tongtext(ByVal Rng As Range, Optional Txt As String = "*") As Double
Dim Cll As Range, Num As Double
For Each Cll In Rng
If Not IsNumeric(Cll.Value) Then
Num = Val(Replace(Left(Cll, InStr(Cll, " ") - 1), ",", "."))
Else
Num = Cll.Value
End If
If Cll.Value Like "*" & Txt & "*" Then
Tongtext = Tongtext + Num
End If
Next Cll
End Function

Thử như vầy xem sao:

PHP:

Public Sub s_TongText()
Const Rng As String = "C10"
Const Cols As Long = 6
Dim sArr(), dArr(), J As Long, CoL As Long, Num As Double, Tmp As Variant, Txt As String
    sArr = Range(Rng).Resize(, Cols).Value
ReDim dArr(1 To 2, 1 To Cols)
With CreateObject("Scripting.Dictionary")
    For J = 1 To Cols
        Tmp = Split(Application.WorksheetFunction.Trim(sArr(1, J)), " ")
        Txt = Tmp(1)
        Num = Val(Replace(Tmp(0), ",", "."))
        If Len(Txt) Then
            If Not .Exists(Txt) Then
                CoL = CoL + 1
                .Item(Txt) = CoL
                dArr(1, CoL) = Txt
                dArr(2, CoL) = Num
            Else
                dArr(2, .Item(Txt)) = dArr(2, .Item(Txt)) + Num
            End If
        End If
    Next J
End With
    Range(Rng).Offset(-1, Cols).Resize(2, CoL) = dArr
End Sub

Cô Bé Dễ Thương · 19/2/21

Thử như vầy xem sao:

PHP:

Public Sub s_TongText()
Const Rng As String = "C10"
Const Cols As Long = 6
Dim sArr(), dArr(), J As Long, CoL As Long, Num As Double, Tmp As Variant, Txt As String
    sArr = Range(Rng).Resize(, Cols).Value
ReDim dArr(1 To 2, 1 To Cols)
With CreateObject("Scripting.Dictionary")
    For J = 1 To Cols
        Tmp = Split(Application.WorksheetFunction.Trim(sArr(1, J)), " ")
        Txt = Tmp(1)
        Num = Val(Replace(Tmp(0), ",", "."))
        If Len(Txt) Then
            If Not .Exists(Txt) Then
                CoL = CoL + 1
                .Item(Txt) = CoL
                dArr(1, CoL) = Txt
                dArr(2, CoL) = Num
            Else
                dArr(2, .Item(Txt)) = dArr(2, .Item(Txt)) + Num
            End If
        End If
    Next J
End With
    Range(Rng).Offset(-1, Cols).Resize(2, CoL) = dArr
End Sub

Cháu cảm ơn chú @Ba Tê, cháu lại biết thêm ông ngoại có cháu gái xinh đây. Phải không chú @ptm0412 nhỉ?
Bài cũ của chú từ lâu rồi giờ lại may mắn đc chú xây lại.

ptm0412 · 19/2/21

emgaimuarao đã viết:
chú @Ba Tê, cháu lại biết thêm ông ngoại có cháu gái xinh đây. Phải không chú @ptm0412 nhỉ?

Chưa chắc, lão @Ba Tê xấu trai, không đẹp như lão chết tiệt làm sao có cháu ngoại xinh

Cô Bé Dễ Thương · 19/2/21

ptm0412 đã viết:
Chưa chắc, lão @Ba Tê xấu trai, không đẹp như lão chết tiệt làm sao có cháu ngoại xinh

Giải pháp excel có khi đổi thành Giải pháp của ông ngoại mới đúng. Mà sao thế hệ các chú lại nội công thâm hậu, môn vba này vậy nhỉ? Học mót lại các chú để chế lại mà còn hóc nổi gân mắt...hic hic

Ba Tê · 19/2/21

ptm0412 đã viết:
Chưa chắc, lão @Ba Tê xấu trai, không đẹp như lão chết tiệt làm sao có cháu ngoại xinh

Híc! Ai giành đẹp lão như "lão chết tiệt" đâu nè/
Tui chỉ có 1 con gái nhưng có 2 cháu ngoại trai, "lời lỗ hổng biết".
Bây giờ chỉ còn vài giờ là tui "hưởng thọ" thêm 1 số.

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

emgaimuarao đã viết:
Giải pháp excel có khi đổi thành Giải pháp của ông ngoại mới đúng. Mà sao thế hệ các chú lại nội công thâm hậu môn vba này vậy nhỉ? Học mót lại các chú để chế lại mà còn hóc nổi gân mắt...hic hic

Có chăng thêm dấu phẩy chỗ này: "nội công thâm hậu, môn vba...", đừng để người đọc "nội công thâm hậu môn" vba ...

Cô Bé Dễ Thương · 19/2/21

Ba Tê đã viết:
Híc! Ai giành đẹp lão như "lão chết tiệt" đâu nè/
Tui chỉ có 1 con gái nhưng có 2 cháu ngoại trai, "lời lỗ hổng biết".
Bây giờ chỉ còn vài giờ là tui "hưởng thọ" thêm 1 số.

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

Có chăng thêm dấu phẩy chỗ này: "nội công thâm hậu, môn vba...", đừng để người đọc "nội công thâm hậu môn" vba ...View attachment 254314

Cháu chúc sinh nhật sớm chú @Ba Tê nhé 20/02/1960 phải không chú nhỉ

concogia · 19/2/21

emgaimuarao đã viết:
Cháu chúc sinh nhật sớm chú @Ba Tê nhé 20/02/1960 phải không chú nhỉ

Trời, mình nhậu với Ba Tê cả đống lần mà hôm nay mới biết sinh nhật bạn hiền. Thật là có lỗi
Sẵn trớn, xin cám ơn bạn emgaimuarao nhiều nhiều

ptm0412 · 19/2/21

concogia đã viết:
Sẵn trớn, xin cám ơn bạn emgaimuarao nhiều nhiều

Người ta khen các ông có cháu ngoại xinh chứ có khen anh đâu mà cám ơn.

concogia · 19/2/21

ptm0412 đã viết:
Người ta khen các ông có cháu ngoại xinh chứ có khen anh đâu mà cám ơn.

Mình cám ơn bạn kia vì nhắc đến sinh nhật của Ba Tê mà
Híc

batman1 · 20/2/21

emgaimuarao đã viết:
Cháu chúc sinh nhật sớm chú @Ba Tê nhé 20/02/1960 phải không chú nhỉ

Cái đỏ đỏ là khi đang viết bài. "Vài giờ" nữa thì nó sẽ tăng thêm 1. Tức phải là 1959. Ở Việt Nam 60 đã nghỉ hưu, sướng nhỉ. Mình hơn 5 tuổi mà nghỉ hưu cùng năm.

Cô Bé Dễ Thương · 20/2/21

batman1 đã viết:
Cái đỏ đỏ là khi đang viết bài. "Vài giờ" nữa thì nó sẽ tăng thêm 1. Tức phải là 1959. Ở Việt Nam 60 đã nghỉ hưu, sướng nhỉ. Mình hơn 5 tuổi mà nghỉ hưu cùng năm.

Vâng ạ.
Thì ra diễn đàn toàn bậc cha bác cả.
Hình như bác định cư ở nước ngoài phải không ạ?

batman1 · 20/2/21

emgaimuarao đã viết:
Vâng ạ.
Thì ra diễn đàn toàn bậc cha bác cả.
Hình như bác định cư ở nước ngoài phải không ạ?

Tôi ở Đông Âu, ở Ba Lan.

Cô Bé Dễ Thương · 20/2/21

batman1 đã viết:
Tôi ở Đông Âu, ở Ba Lan.

Giờ chúng cháu mới biết các ông bụt diễn đàn toàn là bậc cha chú. Giá các bác hiện thông tin về tuổi thì tốt quá, phải không chị OT.
Bác định cư bên đó chắc từ thời trẻ, cháu đoán ít cũng 35 năm. Bác gái là người Ba Lan à bác?

batman1 · 20/2/21

emgaimuarao đã viết:
Bác định cư bên đó chắc từ thời trẻ, cháu đoán ít cũng 35 năm. Bác gái là người Ba Lan à bác?

Hơn chút.
Đúng rồi.

Mà bạn là công an đấy à?

Thông tin thế thôi nhé.

ptm0412 · 20/2/21

batman1 đã viết:
Mà bạn là công an đấy à? Thông tin thế thôi nhé.

Không đến nỗi thế. Có khi bạn ấy tự nhẩm xem phải học bao nhiêu năm nữa cho bằng "bác"

Cô Bé Dễ Thương · 20/2/21

ptm0412 đã viết:
Không đến nỗi thế. Có khi bạn ấy tự nhẩm xem phải học bao nhiêu năm nữa cho bằng "bác"

batman1 đã viết:
Hơn chút.
Đúng rồi.

Mà bạn là công an đấy à? Thông tin thế thôi nhé.

4 chữ của bác thôi là ai cũng biết bác @batman1 văn võ song toàn rồi.
Và cũng biết thêm các bác gái của các bác @batman1 @ptm0412... và các ông bụt trong diễn đàn có con mắt tinh tường rồi.
Thiếu nghĩ tiêu chí chọn vợ,chồng giỏi VBA áp vào bây giờ là chính xác. Khẳng định luôn là trai tài gái sắc cả. (em mới tham gia không tính nhé ^^)

Xin giúp đỡ đổi "Function" thành "Sub" (1 người xem)

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

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

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

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

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

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

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

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

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

Chuyên gia GPE

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

Chuyên gia GPE

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

VetMini cảm ơn anh nhiều. cách của anh giúp nhiều bạn cứng vba chuyển function sang Sud dễ dàng​

Maika8008 cảm ơn anh. đã không tiếc thời gian viết lại cho em thành Sub. Giúp em hiểu thuật toán của function gốc​

batman1 HieuCD cảm ơn các anh đã quan tâm​

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

Chuyên gia GPE

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

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

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

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

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

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

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

Chuyên gia GPE

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

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

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

Bad Excel Member

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

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

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

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

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

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

Bad Excel Member

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

Bad Excel Member

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

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

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

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

File đính kèm

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

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

Bad Excel Member

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

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

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

Gội rồi mới Cạo

Bad Excel Member

Gội rồi mới Cạo

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 thường trực

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

Bad Excel Member

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

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

VetMini cảm ơn anh nhiều. cách của anh giúp nhiều bạn cứng vba chuyển function sang Sud dễ dàng

Maika8008 cảm ơn anh. đã không tiếc thời gian viết lại cho em thành Sub. Giúp em hiểu thuật toán của function gốc

batman1 HieuCD cảm ơn các anh đã quan tâm