Bây giờ tôi chính thức gửi lên các thủ tục mà tôi cải tiến như sau:
Vì dùng định dạng trong VBA về số rắc rối với việc Việt Nam, Quốc tế, ... nên tôi làm hẳn một hàm để thực hiện việc định dạng này.
[warning]
Cũng vì giá trị trên TextBox luôn là dạng Text nên hàm này của tôi cũng trả về dạng Text chứ không phải dạng Number.
[/warning]
[GPECODE=vb]Function NumberFormat(ByVal NumberInString As String, _
ByVal DigiMark As String, _
ByVal DeciMark As String, _
Optional ByVal DecimalPlaces As Variant) As String
If Trim(NumberInString) = "" Then Exit Function
On Error GoTo ExitFunction
Dim sDecimal As String, sDigital As String, lenNum As Long
NumberInString = Replace(Replace(NumberInString, " ", ""), DigiMark, "")
lenNum = InStr(NumberInString, DeciMark)
sDecimal = IIf(lenNum = 0, "", Right(NumberInString, _
Len(NumberInString) - lenNum + 1))
sDigital = Val(Replace(NumberInString, sDecimal, ""))
If IsMissing(DecimalPlaces) = False Then
Dim Dcm As String: Dcm = Mid(1 / 2, 2, 1)
If DeciMark <> Dcm Then sDecimal = Replace(sDecimal, DeciMark, Dcm)
NumberInString = Round(CDbl(sDigital & sDecimal), DecimalPlaces)
NumberInString = Format(NumberInString, "###0." & String(DecimalPlaces, "0"))
NumberInString = Replace(NumberInString, Dcm, DeciMark)
sDecimal = Right(NumberInString, Len(NumberInString) - _
InStr(NumberInString, DeciMark) + 1)
sDigital = Replace(Replace(NumberInString, sDecimal, ""), DeciMark, "")
End If
lenNum = Len(sDigital)
If lenNum < 4 Then
If lenNum = 0 Then sDigital = 0
If IsMissing(DecimalPlaces) Then
NumberFormat = sDigital & sDecimal
Else
NumberFormat = sDigital & IIf(DecimalPlaces = 0, "", sDecimal)
End If
Else
Dim NumArr As Variant, lenDig As Long, i As Long, j As Long, n As Long
lenDig = lenNum Mod 3
If lenDig = 0 Then
ReDim NumArr(1 To lenNum / 3)
For i = 1 To lenNum Step 3
n = n + 1
NumArr(n) = Mid(sDigital, i, 3)
Next
If IsMissing(DecimalPlaces) Then
NumberFormat = Join(NumArr, DigiMark) & sDecimal
Else
NumberFormat = Join(NumArr, DigiMark) & _
IIf(DecimalPlaces = 0, "", sDecimal)
End If
Else
Dim fstNum As String, aftNum As String
fstNum = Left(sDigital, lenDig)
aftNum = Right(sDigital, Len(sDigital) - lenDig)
j = Len(aftNum)
ReDim NumArr(1 To j / 3)
For i = 1 To j Step 3
n = n + 1
NumArr(n) = Mid(aftNum, i, 3)
Next
If IsMissing(DecimalPlaces) Then
NumberFormat = fstNum & DigiMark & Join(NumArr, DigiMark) & sDecimal
Else
NumberFormat = fstNum & DigiMark & Join(NumArr, DigiMark) & _
IIf(DecimalPlaces = 0, "", sDecimal)
End If
End If
End If
ExitFunction:
End Function
[/GPECODE]
[infonotitle]
Như vậy, với các thủ tục chính như sau:[/infonotitle]
[GPECODE=vb]Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
With TextBox1
Dim Mrk As Long: Mrk = InStr(.Text, DauThapPhan)
If Mrk > 0 Then
''Neu con tro (|) dung truoc DauThapPhan thi con tro doi ve phia sau, nut Delete vo hieu
If KeyCode = 46 Then
If .SelStart = Mrk - 1 Then KeyCode = 3: .SelStart = Mrk
End If
''Neu con tro (|) dung truoc DauThapPhan thi nut Delete vo hieu
' If KeyCode = 46 Then
' If .SelStart = Mrk - 1 Then KeyCode = 3
' End If
''Khi dung ban phim so, voi dau cham (.) se chuyen dau:
If (optVN And KeyCode = 188) _
Or (optQT And KeyCode = 190) _
Then GoTo StopWorking
If KeyCode = 110 Then
KeyCode = IIf(CheckType, 188, 190)
StopWorking:
If .SelStart = Mrk - 1 Then
KeyCode = 3
.SelStart = Mrk
.SelLength = 1
ElseIf .SelStart < Mrk - 1 _
Or .SelStart >= Mrk _
Or .SelStart = 0 Then
KeyCode = 3
End If
End If
End If
End With
End Sub
''*************************************************************************************************
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Dim Mrk As Long: Mrk = InStr(TextBox1.Text, DauThapPhan)
If Mrk > 0 And IsNumeric(Chr(KeyAscii)) Then
If KhoangCachThapPhan > 0 Then
If TextBox1.SelStart > Mrk + KhoangCachThapPhan - 1 Then
KeyAscii = 0
End If
End If
ElseIf Not IsNumeric(Chr(KeyAscii)) Then
KeyAscii = 0
End If
End Sub
''*************************************************************************************************
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
With TextBox1
If KeyCode = 86 And Shift = 2 Then
.Text = NumberFormat(.Text, DauPhanCach, DauThapPhan, KhoangCachThapPhan)
Exit Sub
End If
If .Text = "" Then Exit Sub
Dim iSelStart As Long, lenTxt As Long, lenDcm As Long, _
Mrk As Long, isMrk As Boolean
iSelStart = .SelStart: lenTxt = Len(.Text)
Mrk = InStr(.Text, DauThapPhan)
Select Case KeyCode
Case 8
If iSelStart < Mrk Or KhoangCachThapPhan = 0 Then GoTo NextStep
.Text = NumberFormat(.Text, DauPhanCach, DauThapPhan, KhoangCachThapPhan)
.SelStart = IIf(iSelStart, iSelStart - 1, iSelStart)
.SelLength = IIf(.SelStart < Mrk, 0, 1)
Exit Sub
Case 46
If iSelStart < Mrk Then GoTo NextStep
.Text = NumberFormat(.Text, DauPhanCach, DauThapPhan, KhoangCachThapPhan)
.SelStart = iSelStart
If KhoangCachThapPhan Then .SelLength = 1
Exit Sub
Case 48 To 57, 96 To 105
If Mrk > 0 Then
If iSelStart > Mrk Then
isMrk = True: GoTo NextStep
ElseIf iSelStart = Mrk Then
.SelLength = 1: Exit Sub
End If
End If
iSelStart = .SelStart: lenTxt = Len(.Text)
NextStep:
.Text = NumberFormat(.Text, DauPhanCach, DauThapPhan, KhoangCachThapPhan)
If KhoangCachThapPhan Then
lenDcm = IIf(lenTxt = 1, KhoangCachThapPhan + 1, 0)
End If
lenTxt = Len(.Text) - lenTxt - lenDcm
iSelStart = IIf(iSelStart + lenTxt < 0, 0, iSelStart + lenTxt)
.SelStart = iSelStart
If isMrk Then .SelLength = 1: isMrk = False
End Select
End With
End Sub
[/GPECODE]
[note]
Tải file về tại bài số 3 của topic này:[/note]
http://www.giaiphapexcel.com/forum/...-TIẾP-KHI-GÕ-TRÊN-TEXTBOX&p=464323#post464323
