Option Explicit
Function TongChuoi(ByVal Rng As Range) As String
Dim C As Range, Tmp As String, fT As Long, mT As Long, eT As Long
Dim i As Long, eTmp As String, mTmp As String, iM As String
For Each C In Rng
If Len(C.Value) And IsNumeric(C.Value) Then
Tmp = CStr(C.Value)
If Len(Tmp) < 8 Then
eT = eT + Tmp
ElseIf Len(Tmp) < 15 Then
eT = eT + CLng(Right(Tmp, 7))
mT = mT + CLng(Left(Tmp, Len(Tmp) - 7))
Else
eT = eT + CLng(Right(Tmp, 7))
mT = mT + CLng(Mid(Tmp, 8, 7))
fT = fT + CLng(Left(Tmp, Len(Tmp) - 14))
End If
End If
Next
eTmp = CStr(eT): mTmp = CStr(mT)
If Len(eTmp) > 7 Then
iM = (mT + CLng(Left(eTmp, Len(eTmp) - 7)))
If Len(CStr(iM)) > 7 Then
TongChuoi = (fT + CLng(Left(iM, Len(iM) - 7))) & Right(iM, 7) & Right(eT, 7)
Else
TongChuoi = IIf(fT = 0, "", fT) & iM & Right(eT, 7)
End If
ElseIf Len(eTmp) = 7 Then
If Len(mTmp) > 7 Then
TongChuoi = (fT + CLng(Left(mTmp, Len(mTmp) - 7))) & Right(mTmp, 7) & eTmp
Else
TongChuoi = IIf(fT = 0, "", fT) & mTmp & eTmp
End If
Else
TongChuoi = IIf(fT = 0, "", fT) & IIf(iM = 0, "", iM) & eT
End If
End Function
Lưu ý: tính toán dữ liệu kiểu Long nên xảy ra lỗi với số liệu quá lớn.
Option Explicit
Function TongChuoi(ByVal Rng As Range) As String
Dim C As Range, Tmp As String, fT As Long, mT As Long, eT As Long
Dim i As Long, eTmp As String, mTmp As String, iM As String
For Each C In Rng
If Len(C.Value) And IsNumeric(C.Value) Then
Tmp = CStr(C.Value)
If Len(Tmp) < 8 Then
eT = eT + Tmp
ElseIf Len(Tmp) < 15 Then
eT = eT + CLng(Right(Tmp, 7))
mT = mT + CLng(Left(Tmp, Len(Tmp) - 7))
Else
eT = eT + CLng(Right(Tmp, 7))
mT = mT + CLng(Mid(Tmp, 8, 7))
fT = fT + CLng(Left(Tmp, Len(Tmp) - 14))
End If
End If
Next
eTmp = CStr(eT): mTmp = CStr(mT)
If Len(eTmp) > 7 Then
iM = (mT + CLng(Left(eTmp, Len(eTmp) - 7)))
If Len(CStr(iM)) > 7 Then
TongChuoi = (fT + CLng(Left(iM, Len(iM) - 7))) & Right(iM, 7) & Right(eT, 7)
Else
TongChuoi = IIf(fT = 0, "", fT) & iM & Right(eT, 7)
End If
ElseIf Len(eTmp) = 7 Then
If Len(mTmp) > 7 Then
TongChuoi = (fT + CLng(Left(mTmp, Len(mTmp) - 7))) & Right(mTmp, 7) & eTmp
Else
TongChuoi = IIf(fT = 0, "", fT) & mTmp & eTmp
End If
Else
TongChuoi = IIf(fT = 0, "", fT) & IIf(iM = 0, "", iM) & eT
End If
End Function
Lưu ý: tính toán dữ liệu kiểu Long nên xảy ra lỗi với số liệu quá lớn.
Thực ra, bài này thì phải hỏi lại thớt xem muốn chữ số 16 để làm gì.
1. Nếu chỉ cần tới 28 chữ số thì dùng kiểu Decimal (Variant và hàm CDec)
2. Nếu cần hơn nữa thì bắt buộc phải dùng các thuật toán của Big Integer (tra từ này sẽ thấy cả đống thuật toán)
Phép cộng thì đơn giản thôi. Nhưng hàm sai thì phải.
F15 = 26998472531621057637452 trong khi cộng tay nếu không lầm thì phải là 26998472484772987637452. Tức các chữ số 9-16 sai.
Thực ra, bài này thì phải hỏi lại thớt xem muốn chữ số 16 để làm gì.
1. Nếu chỉ cần tới 28 chữ số thì dùng kiểu Decimal (Variant và hàm CDec)
2. Nếu cần hơn nữa thì bắt buộc phải dùng các thuật toán của Big Integer (tra từ này sẽ thấy cả đống thuật toán)
Công thức tính số lớn vượt quá 15 ký tự số đã có rồi.
Chúng ta không nên bỏ nhiều chất xám vào cái người ta đã viết rồi,
mắc công già thì phải "ăn cháo sâm, yến, bào ngư" để lấy lại "sinh lực".
Trẻ thì lại nhanh "bạc đầu"
------------------------------------------------------------------------------------------ Số học số lượng lớn
Excel và VBA hỗ trợ số chính xác cho một số chữ số. Giới hạn trong Excel là 15 chữ số có nghĩa trong một số. Nhập số thẻ tín dụng gồm 16 chữ số và 1234567890123456 sẽ trở thành 1234567890123450. Giới hạn trong VBA tùy thuộc vào loại dữ liệu. Trong số các loại dữ liệu số phổ biến Integer, Long, Single và Double, một biến loại Long có thể lưu trữ một số từ -2,147,483,648 đến 2,147,483,647 trong khi loại dữ liệu Double hỗ trợ 15 chữ số chính xác: -1.79769313486231E308 đến -4.94065645841247 giá trị âm; 4.94065645841247E-324 đến 1.79769313486232E308 cho các giá trị dương.
Hai loại dữ liệu không phổ biến là Tiền tệ và Số thập phân. Kiểu dữ liệu Tiền tệ lưu trữ 19 chữ số chính xác với các số từ -922,337,203,685,477,5808 đến 922,337,203,685,477,5807 và loại dữ liệu thập phân lưu trữ chính xác 29 chữ số. Từ tệp trợ giúp của VBA:
"+/- 79,228,162,514,264,337,593,543,950,335 đối với các số có tỷ lệ bằng 0, nghĩa là các số không có số thập phân. . "
Vậy, làm thế nào để một người làm việc với các số dài hơn số được hỗ trợ dài nhất? Cách duy nhất để lưu trữ một số như vậy là văn bản (một biến Chuỗi trong VBA). Để lưu trữ tất cả 16 ký tự của thẻ tín dụng trong một ô Excel, trước tiên hãy chọn một ô và đặt định dạng thành Văn bản. Bây giờ, nhập 16 ký tự của thẻ tín dụng, tức là 1234567890123456. Excel sẽ hiển thị tất cả 16 ký tự.
Điều này là tốt như nó đi. Thật không may, vì ô chứa văn bản (xem thử nghiệm cho ISNUMBER trong hình ảnh bên dưới), nó không thể được sử dụng để tính toán và nếu bạn làm như vậy, Excel sẽ tự động trở lại giới hạn 15 chữ số (một lần nữa, xem hình ảnh bên dưới).
Giới hạn khái niệm tương tự tồn tại trong VBA. Khi chúng tôi đạt đến giới hạn cho một loại dữ liệu cụ thể, VBA sẽ chuyển sang loại dữ liệu kép và tiếp tục trả kết quả về độ chính xác 15 chữ số. Ví dụ: trong Trình soạn thảo Visual Basic, hãy mở Cửa sổ ngay lập tức và nhập? 2 ^ 49. Kết quả sẽ là 562949953421312. Bây giờ, hãy nhập? 2 ^ 50 và kết quả sẽ là 1.12589990684262E + 15, là 112589906842620. Nhưng, điều đó không chính xác vì kết quả chính xác là 112589906842624, một cái gì đó không chính xác vì kết quả đúng là 112589906842624. kiểu dữ liệu dài hoặc kép. Người ta có thể mở rộng độ chính xác của kết quả bằng việc sử dụng kiểu dữ liệu thập phân. Để tính 2 ^ 95, sử dụng? Cdec (2 ^ cdec (46)) * 2 ^ cdec (49) để lấy 39614081257132168796771975168 hoặc 29 chữ số chính xác. Nhưng, bất cứ điều gì nữa, tức là, 2 ^ 96, vượt quá giới hạn của ngay cả kiểu dữ liệu thập phân,
Cách duy nhất để tính kết quả ngoài mức độ chính xác này là xây dựng các thuật toán của riêng chúng tôi. Chìa khóa của algoritmns và mã VBA liên quan sẽ là chia số lớn thành số nhỏ hơn trả về kết quả trong giới hạn của kiểu dữ liệu thập phân. Sau đó, chúng tôi lắp ráp lại các kết quả thành phần vào kết quả hoàn chỉnh cuối cùng.
Bổ sung số lượng lớn
Đây là khối xây dựng cơ bản vì bổ sung là một yêu cầu cho phép nhân. Và, nó là dễ hiểu nhất. Chúng tôi sẽ xem xét một vấn đề nhỏ để hiểu các khái niệm. Cân nhắc thêm một số có 4 chữ số vào một số có 4 chữ số khác với yêu cầu chúng tôi không được phép làm việc với hơn 2 chữ số cùng một lúc. Vì vậy, chúng tôi không thể trực tiếp thêm 1001 và 1002. Thay vào đó, chúng tôi chia hai số thành 10 và 01 và 10 và 02 tương ứng, thêm các thành phần lại với nhau và đặt kết quả lại với nhau để có được 2003
10 01
10 02
-----
20 03
Có ba vấn đề cần xem xét trong tính toán này. Đầu tiên, khi chúng ta chuyển đổi 01 và 02 thành số, chúng thành 1 và 2 và kết quả là 3, không phải 03. Vì vậy, nếu kết quả của phép cộng nhỏ hơn độ dài của số ban đầu, chúng ta cần đệm kết quả bằng số không hàng đầu. Vấn đề thứ hai là độ dài của các con số. Để giữ cho vấn đề đơn giản, chúng tôi sẽ làm việc trên các số có cùng độ dài. Vì vậy, nếu một số nhỏ hơn số kia, chúng ta sẽ đệm nó với các số 0 đứng đầu. Vấn đề thứ ba cần nhớ là chữ số mang theo. Khi chúng tôi thêm 9 và 9, chúng tôi nhận được 8 với số lần chuyển là 1. Do đó, việc thêm chữ số có nghĩa tiếp theo phải bao gồm số mang này. Khi chúng tôi nhận được một chuyển giao từ toàn bộ số, chữ số chuyển đổi phải được thêm vào phần bổ sung tiếp theo, chúng tôi thực hiện với các phần tử ở bên trái của các số.
Đây là một ví dụ kết hợp tất cả các quy tắc. Giả sử chúng ta muốn thêm các số được biểu thị bằng các chuỗi "906002" và "98501" và chúng ta chỉ có thể hoạt động 2 chữ số cùng một lúc. Vì một số nhỏ hơn số kia, chúng tôi đệm nó sang bên trái để lấy 906002 + 098501.
Bây giờ, chúng ta nhìn vào 2 chữ số đầu tiên bên phải. 02 + 01 trở thành 3. Nhưng, vì chúng tôi đã bắt đầu với 2 chữ số, chúng tôi đệm kết quả để có được chuỗi kết quả một phần là 03.
Tiếp theo, thêm 60 và 85 mang lại 45 với số lần chuyển là 1. Chuỗi kết quả một phần hiện là 4503.
Tiếp theo, phần bổ sung tiếp theo áp dụng cho 90 và 09. Chúng tôi thêm phần mang lại từ phần bổ sung trước để nhận 00 với phần mang khác là 1 và chuỗi kết quả một phần là 004503.
Cuối cùng, vì chúng ta đang ở cuối quá trình bổ sung, chúng ta chỉ cần đặt phần chuyển đổi 1 ở bên trái chuỗi kết quả để có kết quả cuối cùng 1004503.
Hàm LargeAdd thực hiện cùng một khái niệm ngoại trừ nó hoạt động với số có 28 chữ số (nhỏ hơn 1 so với giới hạn của kiểu dữ liệu thập phân là 29 chữ số). Nhưng, trước khi chúng ta thực hiện chức năng bổ sung, chúng ta cần một số hằng số. Lý do cho các trích dẫn là chúng ta không thể khai báo hằng số của kiểu dữ liệu Thập phân. Vì vậy, chúng ta phải sử dụng một thói quen khởi tạo để tạo các hằng số. Nếu chúng ta đang tạo một lớp cho Số học lớn, bên dưới sẽ là mã class_initialize. Ngoài ra, 3 thuộc tính tương ứng sẽ chỉ có các thủ tục Nhận, về cơ bản làm cho chúng thuộc tính ReadOnly. Chúng tôi sẽ sử dụng hai hằng số đầu tiên trong quá trình bổ sung. Thứ ba, cSqrDecMaxLen, được yêu cầu cho thói quen nhân.
Tùy chọn rõ ràng
Công khai cDecMax là biến thể, cDecMaxLen là số nguyên, cSqrDecMaxLen là số nguyên
PHP:
Option Explicit
Public cDecMax As Variant, cDecMaxLen As Integer, cSqrDecMaxLen As Integer
Public Sub Initialize()
Static Initialized As Boolean
If Initialized Then Exit Sub
Initialized = True
cDecMax = _
CDec(Replace("79,228,162,514,264,337,593,543,950,335", ",", ""))
'this is 2^96-1'
cDecMaxLen = Len(cDecMax) - 1
cSqrDecMaxLen = cDecMaxLen \ 2
End Sub
Function Ceil(X As Single) As Long
If X < 0 Then Ceil = Fix(X) Else Ceil = -Int(-X)
End Function
Private Function addByParts(ByVal Nbr1 As String, ByVal Nbr2 As String) _
As String
Dim NbrChunks As Integer
If Len(Nbr1) > Len(Nbr2) Then _
Nbr2 = String(Len(Nbr1) - Len(Nbr2), "0") & Nbr2 _
Else _
Nbr1 = String(Len(Nbr2) - Len(Nbr1), "0") & Nbr1
NbrChunks = Ceil(Len(Nbr1) / cDecMaxLen)
Dim I As Integer, OverflowDigit As String, Rslt As String
OverflowDigit = "0"
For I = NbrChunks - 1 To 0 Step -1
Dim Nbr1Part As String
Nbr1Part = Mid(Nbr1, I * cDecMaxLen + 1, cDecMaxLen)
Rslt = CStr(CDec(Nbr1Part) _
+ CDec(Mid(Nbr2, I * cDecMaxLen + 1, cDecMaxLen)) _
+ CDec(OverflowDigit))
If Len(Rslt) < Len(Nbr1Part) Then
Rslt = String(Len(Nbr1Part) - Len(Rslt), "0") & Rslt
OverflowDigit = "0"
ElseIf I = 0 Then
ElseIf Len(Rslt) > Len(Nbr1Part) Then
OverflowDigit = Left(Rslt, 1): Rslt = Right(Rslt, Len(Rslt) - 1)
Else
OverflowDigit = "0"
End If
addByParts = Rslt & addByParts
Next I
End Function
Function LargeAdd(ByVal Nbr1 As String, ByVal Nbr2 As String) As String
Initialize
If Len(Nbr1) <= cDecMaxLen And Len(Nbr2) <= cDecMaxLen Then
LargeAdd = CStr(CDec(Nbr1) + CDec(Nbr2))
Exit Function
End If
If Len(Nbr1) > cDecMaxLen Then LargeAdd = addByParts(Nbr1, Nbr2) _
Else LargeAdd = addByParts(Nbr2, Nbr1)
End Function
Nhân số lớn
Ý tưởng đằng sau phép nhân số lớn tương tự như được sử dụng ở trên theo nghĩa mà chúng ta thực hiện trong mã, sử dụng chuỗi và kiểu dữ liệu thập phân, cách thức nhân "bằng tay". Hãy xem xét phép nhân của 2 số 1002 và 1001. Nếu chúng ta thực hiện từng chữ số một, chúng ta sẽ nhận được
1002
1001
----
1002
0000x
0000xx
1002xxx
-------
1003002
Nếu chúng tôi đã nhân 2 chữ số cùng một lúc, chúng tôi sẽ nhận được
1002
1001
----
1002
10020xx
-------
1003002
Về cơ bản, chúng tôi nhân kết quả của mỗi phép nhân một phần với lũy thừa của 10 phép nhân trước đó. Tất nhiên, cách dễ nhất để làm điều đó là chỉ cần dịch chuyển kết quả sang bên trái bằng nhiều chữ số như lũy thừa 10. Trong ví dụ đầu tiên, ở trên, chúng tôi đã thay đổi kết quả còn lại 1, 2 và cuối cùng, 3 chữ số trong mỗi phép nhân một phần. Trong ví dụ thứ hai, vì chúng ta đã nhân 2 chữ số cùng một lúc, sự thay đổi là 2 chữ số. Mã dưới đây thực hiện khái niệm đó ngoại trừ nó hoạt động trên kiểu dữ liệu thập phân. Giới hạn số lượng chữ số trong mỗi phép nhân đảm bảo rằng kết quả phù hợp với kiểu dữ liệu thập phân (29 chữ số).
PHP:
Private Function factorOneNbr(ByVal LargeNbr As String, _
ByVal Nbr2 As String) As String
Dim NbrChunks As Integer, I As Integer, _
Nbr1Part As String, PowersOf10 As Integer, _
Rslt As String, FinalRslt As String
FinalRslt = "0"
NbrChunks = Ceil(Len(LargeNbr) / cSqrDecMaxLen) - 1
For I = NbrChunks To 0 Step -1
Nbr1Part = Mid(LargeNbr, I * cSqrDecMaxLen + 1, cSqrDecMaxLen)
Rslt = LargeMult(Nbr1Part, Nbr2)
FinalRslt = LargeAdd(FinalRslt, Rslt & String(PowersOf10, "0"))
PowersOf10 = PowersOf10 + Len(Nbr1Part)
Next I
factorOneNbr = FinalRslt
End Function
Function LargeMult(ByVal Nbr1 As String, ByVal Nbr2 As String) As String
Initialize
If Len(Nbr1) <= cSqrDecMaxLen And Len(Nbr2) <= cSqrDecMaxLen Then
LargeMult = CStr(CDec(Nbr1) * CDec(Nbr2))
Exit Function
End If
If Len(Nbr1) > cSqrDecMaxLen Then
LargeMult = factorOneNbr(Nbr1, Nbr2)
Else
LargeMult = factorOneNbr(Nbr2, Nbr1)
End If
End Function
Quyền hạn của số lượng lớn
Để tính một số với công suất nguyên dương, người ta có thể nhân số đó với số lần đó nhiều lần. Mã dưới đây sử dụng hàm LargeMult từ phía trên để làm việc đó.
PHP:
Function LargePower(ByVal Nbr As String, ByVal Power As Integer)
Dim I As Integer
LargePower = "1"
For I = 1 To Power
LargePower = LargeMult(LargePower, Nbr)
Next I
End Function
Yếu tố số lượng lớn
Với chức năng LargeMult ở trên, giai thừa tương đối dễ dàng. Rốt cuộc, n! = 1 * 2 * * (n-2) * (n-1) * n. Theo mặc định, Excel có thể tính 169! nhưng thất bại ở 170! Mã dưới đây cho phép một người mở rộng kết quả lên 32767!, Mặc dù điều đó có thể mất một chút thời gian để tính toán. Tính 1000! trả về kết quả với 2.568 chữ số chỉ trong chưa đầy 10 giây.
PHP:
Function LargeFactorial(ByVal Nbr As Integer) As String
Dim I As Integer, StartTime As Single
'StartTime = Timer'
LargeFactorial = "1"
For I = 1 To Nbr
LargeFactorial = LargeMult(LargeFactorial, I)
Next I
'Debug.Print Timer - StartTime'
End Function
Sử dụng các hàm lớn trong Excel
Mỗi hàm công khai ở trên (LargeAdd, LargeMult, LargePower và LargeFactorial) đều có thể sử dụng được từ bên trong VBA hoặc dưới dạng hàm do người dùng xác định (UDF) trong Excel. Chỉ cần lưu ý rằng các hàm hoạt động trên các chuỗi chỉ chứa các số và có * không * kiểm tra an toàn trong bất kỳ chức năng nào. Vì vậy, đưa ra bất kỳ trong số chúng đối số được định dạng xấu và kết quả sẽ không thể đoán trước.
Tóm lược
Phần này giới thiệu một số hàm chính hoạt động với các số chứa nhiều chữ số có độ chính xác của Excel thậm chí là VBA. Các chức năng hiện tại bao gồm LargeAdd, LargeMult, LargePower và LargeFactorial.
------------------------------------------------------------------------------------------
Toàn bộ Code của bài viết:
------------------------------------------------------------------------------------------
PHP:
Option Explicit
Public cDecMax As Variant, cDecMaxLen As Integer, cSqrDecMaxLen As Integer
Public Sub Initialize()
Static Initialized As Boolean
If Initialized Then Exit Sub
Initialized = True
cDecMax = _
CDec(Replace("79,228,162,514,264,337,593,543,950,335", ",", ""))
'this is 2^96-1'
cDecMaxLen = Len(cDecMax) - 1
cSqrDecMaxLen = cDecMaxLen \ 2
End Sub
Function Ceil(X As Single) As Long
If X < 0 Then Ceil = Fix(X) Else Ceil = -Int(-X)
End Function
Private Function addByParts(ByVal Nbr1 As String, ByVal Nbr2 As String) _
As String
Dim NbrChunks As Integer
If Len(Nbr1) > Len(Nbr2) Then _
Nbr2 = String(Len(Nbr1) - Len(Nbr2), "0") & Nbr2 _
Else _
Nbr1 = String(Len(Nbr2) - Len(Nbr1), "0") & Nbr1
NbrChunks = Ceil(Len(Nbr1) / cDecMaxLen)
Dim I As Integer, OverflowDigit As String, Rslt As String
OverflowDigit = "0"
For I = NbrChunks - 1 To 0 Step -1
Dim Nbr1Part As String
Nbr1Part = Mid(Nbr1, I * cDecMaxLen + 1, cDecMaxLen)
Rslt = CStr(CDec(Nbr1Part) _
+ CDec(Mid(Nbr2, I * cDecMaxLen + 1, cDecMaxLen)) _
+ CDec(OverflowDigit))
If Len(Rslt) < Len(Nbr1Part) Then
Rslt = String(Len(Nbr1Part) - Len(Rslt), "0") & Rslt
OverflowDigit = "0"
ElseIf I = 0 Then
ElseIf Len(Rslt) > Len(Nbr1Part) Then
OverflowDigit = Left(Rslt, 1): Rslt = Right(Rslt, Len(Rslt) - 1)
Else
OverflowDigit = "0"
End If
addByParts = Rslt & addByParts
Next I
End Function
Function LargeAdd(ByVal Nbr1 As String, ByVal Nbr2 As String) As String
Initialize
If Len(Nbr1) <= cDecMaxLen And Len(Nbr2) <= cDecMaxLen Then
LargeAdd = CStr(CDec(Nbr1) + CDec(Nbr2))
Exit Function
End If
If Len(Nbr1) > cDecMaxLen Then LargeAdd = addByParts(Nbr1, Nbr2) _
Else LargeAdd = addByParts(Nbr2, Nbr1)
End Function
Private Function factorOneNbr(ByVal LargeNbr As String, _
ByVal Nbr2 As String) As String
Dim NbrChunks As Integer, I As Integer, _
Nbr1Part As String, PowersOf10 As Integer, _
Rslt As String, FinalRslt As String
FinalRslt = "0"
NbrChunks = Ceil(Len(LargeNbr) / cSqrDecMaxLen) - 1
For I = NbrChunks To 0 Step -1
Nbr1Part = Mid(LargeNbr, I * cSqrDecMaxLen + 1, cSqrDecMaxLen)
Rslt = LargeMult(Nbr1Part, Nbr2)
FinalRslt = LargeAdd(FinalRslt, Rslt & String(PowersOf10, "0"))
PowersOf10 = PowersOf10 + Len(Nbr1Part)
Next I
factorOneNbr = FinalRslt
End Function
Function LargeMult(ByVal Nbr1 As String, ByVal Nbr2 As String) As String
Initialize
If Len(Nbr1) <= cSqrDecMaxLen And Len(Nbr2) <= cSqrDecMaxLen Then
LargeMult = CStr(CDec(Nbr1) * CDec(Nbr2))
Exit Function
End If
If Len(Nbr1) > cSqrDecMaxLen Then
LargeMult = factorOneNbr(Nbr1, Nbr2)
Else
LargeMult = factorOneNbr(Nbr2, Nbr1)
End If
End Function
Function LargePower(ByVal Nbr As String, ByVal Power As Integer)
Dim I As Integer
LargePower = "1"
For I = 1 To Power
LargePower = LargeMult(LargePower, Nbr)
Next I
End Function
Function LargeFactorial(ByVal Nbr As Integer) As String
Dim I As Integer, StartTime As Single
'StartTime = Timer'
LargeFactorial = "1"
For I = 1 To Nbr
LargeFactorial = LargeMult(LargeFactorial, I)
Next I
'Debug.Print Timer - StartTime'
End Function
Công thức tính số lớn vượt quá 15 ký tự số đã có rồi.
Chúng ta không nên bỏ nhiều chất xám vào cái người ta đã viết rồi,
mắc công già thì phải "ăn cháo sâm, yến, bào ngư" để lấy lại "sinh lực".
Trẻ thì lại nhanh "bạc đầu"
-------------------------------------
PHP:
Option Explicit
Public cDecMax As Variant, cDecMaxLen As Integer, cSqrDecMaxLen As Integer
Public Sub Initialize()
Static Initialized As Boolean
If Initialized Then Exit Sub
Initialized = True
cDecMax = _
CDec(Replace("79,228,162,514,264,337,593,543,950,335", ",", ""))
'this is 2^96-1'
cDecMaxLen = Len(cDecMax) - 1
cSqrDecMaxLen = cDecMaxLen \ 2
End Sub
Function Ceil(X As Single) As Long
If X < 0 Then Ceil = Fix(X) Else Ceil = -Int(-X)
End Function
Private Function addByParts(ByVal Nbr1 As String, ByVal Nbr2 As String) _
As String
Dim NbrChunks As Integer
If Len(Nbr1) > Len(Nbr2) Then _
Nbr2 = String(Len(Nbr1) - Len(Nbr2), "0") & Nbr2 _
Else _
Nbr1 = String(Len(Nbr2) - Len(Nbr1), "0") & Nbr1
NbrChunks = Ceil(Len(Nbr1) / cDecMaxLen)
Dim I As Integer, OverflowDigit As String, Rslt As String
OverflowDigit = "0"
For I = NbrChunks - 1 To 0 Step -1
Dim Nbr1Part As String
Nbr1Part = Mid(Nbr1, I * cDecMaxLen + 1, cDecMaxLen)
Rslt = CStr(CDec(Nbr1Part) _
+ CDec(Mid(Nbr2, I * cDecMaxLen + 1, cDecMaxLen)) _
+ CDec(OverflowDigit))
If Len(Rslt) < Len(Nbr1Part) Then
Rslt = String(Len(Nbr1Part) - Len(Rslt), "0") & Rslt
OverflowDigit = "0"
ElseIf I = 0 Then
ElseIf Len(Rslt) > Len(Nbr1Part) Then
OverflowDigit = Left(Rslt, 1): Rslt = Right(Rslt, Len(Rslt) - 1)
Else
OverflowDigit = "0"
End If
addByParts = Rslt & addByParts
Next I
End Function
Function LargeAdd(ByVal Nbr1 As String, ByVal Nbr2 As String) As String
Initialize
If Len(Nbr1) <= cDecMaxLen And Len(Nbr2) <= cDecMaxLen Then
LargeAdd = CStr(CDec(Nbr1) + CDec(Nbr2))
Exit Function
End If
If Len(Nbr1) > cDecMaxLen Then LargeAdd = addByParts(Nbr1, Nbr2) _
Else LargeAdd = addByParts(Nbr2, Nbr1)
End Function
Private Function factorOneNbr(ByVal LargeNbr As String, _
ByVal Nbr2 As String) As String
Dim NbrChunks As Integer, I As Integer, _
Nbr1Part As String, PowersOf10 As Integer, _
Rslt As String, FinalRslt As String
FinalRslt = "0"
NbrChunks = Ceil(Len(LargeNbr) / cSqrDecMaxLen) - 1
For I = NbrChunks To 0 Step -1
Nbr1Part = Mid(LargeNbr, I * cSqrDecMaxLen + 1, cSqrDecMaxLen)
Rslt = LargeMult(Nbr1Part, Nbr2)
FinalRslt = LargeAdd(FinalRslt, Rslt & String(PowersOf10, "0"))
PowersOf10 = PowersOf10 + Len(Nbr1Part)
Next I
factorOneNbr = FinalRslt
End Function
Function LargeMult(ByVal Nbr1 As String, ByVal Nbr2 As String) As String
Initialize
If Len(Nbr1) <= cSqrDecMaxLen And Len(Nbr2) <= cSqrDecMaxLen Then
LargeMult = CStr(CDec(Nbr1) * CDec(Nbr2))
Exit Function
End If
If Len(Nbr1) > cSqrDecMaxLen Then
LargeMult = factorOneNbr(Nbr1, Nbr2)
Else
LargeMult = factorOneNbr(Nbr2, Nbr1)
End If
End Function
Function LargePower(ByVal Nbr As String, ByVal Power As Integer)
Dim I As Integer
LargePower = "1"
For I = 1 To Power
LargePower = LargeMult(LargePower, Nbr)
Next I
End Function
Function LargeFactorial(ByVal Nbr As Integer) As String
Dim I As Integer, StartTime As Single
'StartTime = Timer'
LargeFactorial = "1"
For I = 1 To Nbr
LargeFactorial = LargeMult(LargeFactorial, I)
Next I
'Debug.Print Timer - StartTime'
End Function
Công thức tính số lớn vượt quá 15 ký tự số đã có rồi.
Chúng ta không nên bỏ nhiều chất xám vào cái người ta đã viết rồi,
mắc công già thì phải "ăn cháo sâm, yến, bào ngư" để lấy lại "sinh lực".
Trẻ thì lại nhanh "bạc đầu"
"Những ngày đầu" viết được một code đơn giản chạy không có lỗi là đã mừng lắm rồi. Sau đó là những niềm vui lớn hơn với nhưng code phức tạp hơn. Vd. code để cộng các số có số chữ số bất kỳ. Làm bằng tay trên giấy thì dễ rồi, số ký tự cũng không giới hạn. Viết code thì cứ theo như cộng trên giấy thôi.
Theo đúng qui tắc cộng trên giấy và không dùng mẹo gì cả thì là code
Mã:
Function AddStr(ByVal s1 As String, s2 As String) As String
Dim max As Long, tmp1 As String, tmp2 As String, du As Long, k As Long
If Len(s1) < Len(s2) Then
max = Len(s2)
Else
max = Len(s1)
End If
tmp1 = IIf(Len(s1) < max, String(max - Len(s1), "0"), "") & s1
tmp2 = IIf(Len(s2) < max, String(max - Len(s2), "0"), "") & s2
du = 0
For k = max To 1 Step -1
du = du + Mid(tmp1, k, 1) + Mid(tmp2, k, 1)
Mid(tmp1, k, 1) = du Mod 10
du = du \ 10
Next k
If du Then tmp1 = du & tmp1
AddStr = tmp1
End Function
Tôi nghĩ AddStr không kém cỏi hơn LargeAdd. Tất nhiên ở đây ta không xét về nhu cầu, liệu có ai cộng 2 số mà mỗi số có 1 triệu chữ số. Nhưng nếu hàm đã đeo huy hiệu LargeAdd thì cũng nên phục vụ số chữ số là bất kỳ, y như trên giấy.
LargeAdd sẽ có lỗi vd. khi chuỗi có 33 000 lý tự. Nếu ta sửa trong addByParts thành NbrChunks As Long, I As Long thì không còn lỗi.
Code để test
Mã:
Sub test()
Dim s1 As String, s2 As String, s As String, k As String, t
s1 = String(100000, "8")
s2 = String(100000, "9")
t = Timer
s = AddStr(s1, s2)
Debug.Print Timer - t
t = Timer
k = LargeAdd(s1, s2)
Debug.Print Timer - t
Debug.Print s = k
End Sub
Ta thấy thời gian của AddStr tăng đều trong khi đó thời gian của LargeAdd tăng ... Với 1 000 000 ký tự thì AddStr = 3,11 còn LargeAdd = 192,34
-------------
Vẫn là theo các qui tắc công trên giấy nhưng dùng chút mẹo thì có code
Mã:
Private Function StringToArrayValue(ByVal number As String)
Dim k As Long, n As Long, result() As String
On Error GoTo end_
k = (Len(number) + 6) \ 7
ReDim result(1 To k)
result(1) = Left(number, Len(number) - 7 * (k - 1))
n = Len(CStr(result(1)))
For k = 2 To UBound(result)
result(k) = Mid(number, n + 1 + 7 * (k - 2), 7)
Next k
StringToArrayValue = result
Exit Function
end_:
End Function
Function AddStr(ByVal s1 As String, s2 As String) As String
Dim tmp1 As String, tmp2 As String, Arr1, Arr2, du As Long, k As Long, n As Long
If Len(s1) < Len(s2) Then
n = Len(s2)
Else
n = Len(s1)
End If
tmp1 = IIf(Len(s1) < n, String(n - Len(s1), "0"), "") & s1
tmp2 = IIf(Len(s2) < n, String(n - Len(s2), "0"), "") & s2
Arr1 = StringToArrayValue(tmp1)
Arr2 = StringToArrayValue(tmp2)
If IsEmpty(Arr1) Or IsEmpty(Arr2) Then
AddStr = "Value error"
Exit Function
End If
du = 0
For k = UBound(Arr1) To 1 Step -1
n = du + Arr1(k) + Arr2(k)
Arr1(k) = n Mod 10 ^ 7
If k > 1 Then Arr1(k) = Format(Arr1(k), "0000000")
du = IIf(n >= 10 ^ 7, 1, 0)
Next k
If du Then Arr1(1) = 10 ^ 7 + Arr1(1)
tmp1 = Arr1(1) & String(7 * (UBound(Arr1) - 1), "0")
n = Len(CStr(Arr1(1))) + 1
For k = 2 To UBound(Arr1)
Mid(tmp1, n + 7 * (k - 2), 7) = Arr1(k)
Next k
AddStr = tmp1
End Function
Chưa kiểm tra kỹ nhưng hi vọng là đúng. Nếu có sai thì cũng chỉ là thực hiện chi tiết chưa chuẩn. Còn thuật toán thì rõ ràng rồi.
Phép nhân thì cũng qui tắc như trên giấy thôi. Nhân 2 chữ số - 2 cụm chữ số và có nhớ sang bậc trên. Còn lại chỉ là tạo chuỗi sao cho đúng. Trong trường hợp phép nhân thì nhân 2 cụm có 7 chữ số nhưng kết quả tạo chuỗi là cụm có 14 chữ số. Sau cùng là tính tổng của các kết quả nhân trung gian. Tóm lại là qui tắc cứ như làm trên giấy.
Theo tinh thần của bài #17, "làm trên giấy"
Lúc bạn làm trên giấy thì bạn làm thế nào?
Có hai cách làm:
1. đồng vị dấu thập phân, rút nó ra và cộng/trừ bình thường. Sau đó chèn trở lại.
123.45678 + 51.23 = 12345678 + 5123000 với E-5
2. làm in hệt như trên giấy. Chỉnh hàm cộng/trừ lại thành có thể cộng trừ lệch vị.
123.45678 + 51.23 => lệch 3 vị trí về trái cho 51.23
Nếu làm theo phương pháp 2 thì có thể dùng hàm cộng lệch vị này để cộng lêhcj vị trong toán nhân.
"Những ngày đầu" viết được một code đơn giản chạy không có lỗi là đã mừng lắm rồi. Sau đó là những niềm vui lớn hơn với nhưng code phức tạp hơn. Vd. code để cộng các số có số chữ số bất kỳ. Làm bằng tay trên giấy thì dễ rồi, số ký tự cũng không giới hạn. Viết code thì cứ theo như cộng trên giấy thôi.
Theo đúng qui tắc cộng trên giấy và không dùng mẹo gì cả thì là code
Mã:
Function AddStr(ByVal s1 As String, s2 As String) As String
Dim max As Long, tmp1 As String, tmp2 As String, du As Long, k As Long
If Len(s1) < Len(s2) Then
max = Len(s2)
Else
max = Len(s1)
End If
tmp1 = IIf(Len(s1) < max, String(max - Len(s1), "0"), "") & s1
tmp2 = IIf(Len(s2) < max, String(max - Len(s2), "0"), "") & s2
du = 0
For k = max To 1 Step -1
du = du + Mid(tmp1, k, 1) + Mid(tmp2, k, 1)
Mid(tmp1, k, 1) = du Mod 10
du = du \ 10
Next k
If du Then tmp1 = du & tmp1
AddStr = tmp1
End Function
Tôi nghĩ AddStr không kém cỏi hơn LargeAdd. Tất nhiên ở đây ta không xét về nhu cầu, liệu có ai cộng 2 số mà mỗi số có 1 triệu chữ số. Nhưng nếu hàm đã đeo huy hiệu LargeAdd thì cũng nên phục vụ số chữ số là bất kỳ, y như trên giấy.
LargeAdd sẽ có lỗi vd. khi chuỗi có 33 000 lý tự. Nếu ta sửa trong addByParts thành NbrChunks As Long, I As Long thì không còn lỗi.
Code để test
Mã:
Sub test()
Dim s1 As String, s2 As String, s As String, k As String, t
s1 = String(100000, "8")
s2 = String(100000, "9")
t = Timer
s = AddStr(s1, s2)
Debug.Print Timer - t
t = Timer
k = LargeAdd(s1, s2)
Debug.Print Timer - t
Debug.Print s = k
End Sub
Ta thấy thời gian của AddStr tăng đều trong khi đó thời gian của LargeAdd tăng ... Với 1 000 000 ký tự thì AddStr = 3,11 còn LargeAdd = 192,34
-------------
Vẫn là theo các qui tắc công trên giấy nhưng dùng chút mẹo thì có code
Mã:
Private Function StringToArrayValue(ByVal number As String)
Dim k As Long, n As Long, result() As String
On Error GoTo end_
k = (Len(number) + 6) \ 7
ReDim result(1 To k)
result(1) = Left(number, Len(number) - 7 * (k - 1))
n = Len(CStr(result(1)))
For k = 2 To UBound(result)
result(k) = Mid(number, n + 1 + 7 * (k - 2), 7)
Next k
StringToArrayValue = result
Exit Function
end_:
End Function
Function AddStr(ByVal s1 As String, s2 As String) As String
Dim tmp1 As String, tmp2 As String, Arr1, Arr2, du As Long, k As Long, n As Long
If Len(s1) < Len(s2) Then
n = Len(s2)
Else
n = Len(s1)
End If
tmp1 = IIf(Len(s1) < n, String(n - Len(s1), "0"), "") & s1
tmp2 = IIf(Len(s2) < n, String(n - Len(s2), "0"), "") & s2
Arr1 = StringToArrayValue(tmp1)
Arr2 = StringToArrayValue(tmp2)
If IsEmpty(Arr1) Or IsEmpty(Arr2) Then
AddStr = "Value error"
Exit Function
End If
du = 0
For k = UBound(Arr1) To 1 Step -1
n = du + Arr1(k) + Arr2(k)
Arr1(k) = n Mod 10 ^ 7
If k > 1 Then Arr1(k) = Format(Arr1(k), "0000000")
du = IIf(n >= 10 ^ 7, 1, 0)
Next k
If du Then Arr1(1) = 10 ^ 7 + Arr1(1)
tmp1 = Arr1(1) & String(7 * (UBound(Arr1) - 1), "0")
n = Len(CStr(Arr1(1))) + 1
For k = 2 To UBound(Arr1)
Mid(tmp1, n + 7 * (k - 2), 7) = Arr1(k)
Next k
AddStr = tmp1
End Function
Chưa kiểm tra kỹ nhưng hi vọng là đúng. Nếu có sai thì cũng chỉ là thực hiện chi tiết chưa chuẩn. Còn thuật toán thì rõ ràng rồi.
Phép nhân thì cũng qui tắc như trên giấy thôi. Nhân 2 chữ số - 2 cụm chữ số và có nhớ sang bậc trên. Còn lại chỉ là tạo chuỗi sao cho đúng. Trong trường hợp phép nhân thì nhân 2 cụm có 7 chữ số nhưng kết quả tạo chuỗi là cụm có 14 chữ số. Sau cùng là tính tổng của các kết quả nhân trung gian. Tóm lại là qui tắc cứ như làm trên giấy.
Đáng lý là không quan tâm chủ đề này lắm
Nhưng thấy Bác @batman1 cũng hào hứng trong cái vụ chuỗi số hơn 15 này.
Nên cũng thêm một bài viết cho thêm phần hấp dẫn.
Ở đây em sẽ vận dụng dạng tính toán của VBA mà không đi đâu khác.
Thuật toán cộng trong VBA đã được thực hiện ngay từ Binary. Nên nó rất nhanh.
Vì vậy nếu đã viết code ngay Trong VBA thì ta nên tận dụng nó, thay vì sáng tạo thuật toán mới.
Theo em thì ở đây nên dùng phân đoạn chuỗi và cắt, phụ thuộc giới hạn của VBA. Ở đây chắc hẳn là 15, vì khi CSTR thì ta chỉ có thể thấy được 15 con số.
Và ta chỉ sử dụng là 14:
14 con số + 14 con số = Không bao giờ vượt quá 15 con số
Code dưới đây sẽ nhanh hơn của Bác @batman1 gần 6 lần với 1 triệu ký tự số.
Còn đối với thuật toán Nhân theo em thì không nên viết code theo kiểu nhân trên giấy. Vì nó rất chậm.
Và ta nên sao chép thuật toán của các bậc vĩ nhân. Như đã được nhắc đến tại đây
Function AddStr2$(Optional ByVal numA$ = "0", Optional ByVal numB$ = "0")
Dim MxStr%, I&, cAdd$, em%, LA&, LB&, max&
MxStr = 28
LA = Len(numA): LB = Len(numB)
max = IIf(LA < LB, LB, LA)
numA = String(max - LA, "0") & numA
numB = String(max - LB, "0") & numB
For I = max To 1 Step -1
If I < MxStr Then MxStr = I: I = 1 Else I = I - MxStr + 1
cAdd = CDec(Mid(numA, I, MxStr)) + CDec(Mid(numB, I, MxStr)) + em
Mid(numA, I, MxStr) = Right(cAdd, MxStr)
em = 0: If Len(cAdd) > MxStr Then em = Left(cAdd, 1)
Next I
AddStr2 = IIf(em > 0, em, "") & numA
End Function
