在论坛里面没有找到这个功能，录入数字时，超过3位自动显示千分位

iamsilly 2016-07-16 12:45:13
各位老大，请先看懂我的题目后再回答。
我想在一个文本框text1里面录入数字，数字有可能带小数，在录入的时候，希望自动按千分位显示。
比如我录入数字123456.12，显示效果应该自动是123,456.12
比如我录入数字12345678.12，显示效果应该自动是12，345，678.12
以此类推，不是说输入123456.12，将光标移开后变成123,456.12,这个效果不是我要的效果哈，看清楚。
这个文本框只能录入数字和小数点，或者负号；如果能自动判断是这几个符号就可以录入，如果不是这些符号，比如字母就不能录入最好了。
只回答下面一句就不要贴了，这个我知道的。
text1.text=format(val(text1.text),"#,###.00")
多谢
...全文
533 26 打赏 收藏 转发到动态 举报
写回复
用AI写文章
26 条回复
切换为时间正序
请发表友善的回复…
发表回复
acmay 2018-02-05
  • 打赏
  • 举报
 回复
舉杯邀明月,这个能不能再把限制一个小数点加上，就更完美了
舉杯邀明月 2016-07-20
  • 打赏
  • 举报
 回复
引用 24 楼 sysdzw 的回复:
Private Sub Text1_Change()
    setFormat Text1
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If Not ((KeyAscii > 48 And KeyAscii < 57) Or KeyAscii = 8 Or KeyAscii = 46 Or ((KeyAscii = 43 Or KeyAscii = 45) And Text1.SelStart = 0)) Then KeyAscii = 0
End Sub
Private Sub setFormat(objTxt As TextBox)
    Dim v, strNew$, s1$, intSelStart%
    Dim reg As Object
    Set reg = CreateObject("vbscript.regExp")
    reg.Global = True
    If objTxt.Text = "" Then Exit Sub
    v = Split(objTxt.Text, ".")
    s1 = v(0)
    v(0) = Replace(v(0), ",", "")
    reg.Pattern = "(\d{3})"
    v(0) = StrReverse(reg.Replace(StrReverse(v(0)), "$1,")) '每隔3数字加逗号
    reg.Pattern = "^([^\d]*?),"
    v(0) = reg.Replace(v(0), "$1")
    intSelStart = objTxt.SelStart
    objTxt.Text = Join(v, ".")
    objTxt.SelStart = intSelStart + Len(v(0)) - Len(s1)
End Sub
怎么看还是我的代码最精简。。。
无·法 2016-07-19
  • 打赏
  • 举报
 回复 
Private Sub Text1_Change()
    setFormat Text1
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If Not ((KeyAscii > 48 And KeyAscii < 57) Or KeyAscii = 8 Or KeyAscii = 46 Or ((KeyAscii = 43 Or KeyAscii = 45) And Text1.SelStart = 0)) Then KeyAscii = 0
End Sub
Private Sub setFormat(objTxt As TextBox)
    Dim v, strNew$, s1$, intSelStart%
    Dim reg As Object
    Set reg = CreateObject("vbscript.regExp")
    reg.Global = True
    If objTxt.Text = "" Then Exit Sub
    v = Split(objTxt.Text, ".")
    s1 = v(0)
    v(0) = Replace(v(0), ",", "")
    reg.Pattern = "(\d{3})"
    v(0) = StrReverse(reg.Replace(StrReverse(v(0)), "$1,")) '每隔3数字加逗号
    reg.Pattern = "^([^\d]*?),"
    v(0) = reg.Replace(v(0), "$1")
    intSelStart = objTxt.SelStart
    objTxt.Text = Join(v, ".")
    objTxt.SelStart = intSelStart + Len(v(0)) - Len(s1)
End Sub
怎么看还是我的代码最精简。。。
iamsilly 2016-07-18
  • 打赏
  • 举报
 回复
我会了，Topc008 老师这个最简单。
iamsilly 2016-07-18
  • 打赏
  • 举报
 回复
Topc008 老师，你这个可以做个函数吗？我觉得你这个没有问题！感谢！
笨狗先飞 2016-07-18
  • 打赏
  • 举报
 回复
补丁真是永远也补不完啊~~~ 乱序删除的时候最前面正好有逗号会删不动，只好去掉逗号来处理了， 然后还有个已知的问题，处理过之后光标会跑到最后去 没办法，这个不好处理啊。 

Private Sub Text1_Change()
    Static LastText As String
    Dim Str1 As String, Str2 As String, Str As String
    Str = Replace(Text1.Text, ",", "")
    If IsNumeric(Str & "0") And InStr(LCase(Str), "e") = 0 And InStr(LCase(Str), "d") = 0 Then
        If IsNumeric(Str) Then
            If InStr(Str, ".") Then
                Str1 = Mid(Str, 1, InStr(Str, "."))
                Str2 = Mid(Str, InStr(Str, "."))
            Else
                Str1 = Str
            End If
            Text1.Text = IIf(Left(Str1, 1) = "+", "+", "") & Format(Str1, "#,#") & Str2
            Text1.SelStart = Len(Text1.Text)
        End If
        LastText = Str
    Else
        Text1.Text = LastText
        Text1.SelStart = Len(Text1.Text)
    End If
End Sub
iamsilly 2016-07-18
  • 打赏
  • 举报
 回复
太好了，我先研究下，然后就放分！
笨狗先飞 2016-07-18
  • 打赏
  • 举报
 回复
改一下，还需要过滤科学计数法。。。，这下应该完美了 

Private Sub Text1_Change()
    Static LastText As String
    Dim Str1 As String, Str2 As String
    If IsNumeric(Text1.Text & "0") And InStr(LCase(Text1.Text), "e") = 0 And InStr(LCase(Text1.Text), "d") = 0 Then
        If IsNumeric(Text1.Text) Then
            If InStr(Text1.Text, ".") Then
                Str1 = Mid(Text1.Text, 1, InStr(Text1.Text, "."))
                Str2 = Mid(Text1.Text, InStr(Text1.Text, "."))
            Else
                Str1 = Text1.Text
            End If
            Text1.Text = IIf(Left(Str1, 1) = "+", "+", "") & Format(Str1, "#,#") & Str2
            Text1.SelStart = Len(Text1.Text)
        End If
        LastText = Text1.Text
    Else
        Text1.Text = LastText
    End If
End Sub
笨狗先飞 2016-07-18
  • 打赏
  • 举报
 回复
我也凑个热闹 

Private Sub Text1_Change()
    Static LastText As String
    Dim Str1 As String, Str2 As String
    If IsNumeric(Text1.Text & "0") Then
        If IsNumeric(Text1.Text) Then
            If InStr(Text1.Text, ".") Then
                Str1 = Mid(Text1.Text, 1, InStr(Text1.Text, "."))
                Str2 = Mid(Text1.Text, InStr(Text1.Text, "."))
            Else
                Str1 = Text1.Text
            End If
            Text1.Text = IIf(Left(Str1, 1) = "+", "+", "") & Format(Str1, "#,#") & Str2
            Text1.SelStart = Len(Text1.Text)
        End If
        LastText = Text1.Text
    Else
        Text1.Text = LastText
    End If
End Sub
无·法 2016-07-17
  • 打赏
  • 举报
 回复
下面那个sub加个判断空的代码，不然删除到一个数字不剩的时候就出错了。 
If objTxt.Text = "" Then Exit Sub
无·法 2016-07-17
  • 打赏
  • 举报
 回复 
Private Sub Text1_Change()
    setFormat Text1
End Sub
'传入需要设置的文本框的name即可
Private Sub setFormat(objTxt As TextBox)
    Dim v, s1$, s1_new$, s2$, intSelStart%
    v = Split(objTxt.Text, ".")
    s1 = Replace(v(0), ",", "")
    If UBound(v) > 0 Then s2 = "." & v(1)
    Dim reg As Object
    Set reg = CreateObject("vbscript.regExp")
    reg.Global = True
    reg.Pattern = "(\d{3})"
    s1_new = StrReverse(reg.Replace(StrReverse(s1), "$1,"))
    If Left(s1_new, 1) = "," Then s1_new = Mid(s1_new, 2)
    intSelStart = objTxt.SelStart
    objTxt.Text = s1_new & s2
    objTxt.SelStart = intSelStart + Len(s1_new) - Len(v(0)) ' Len(objTxt.Text)
End Sub
中午抽空写了下，重点还是正则哈
iamsilly 2016-07-17
  • 打赏
  • 举报
 回复
To:Chen8013大哥，还是你懂我，有没有办法解决这个问题呀。
舉杯邀明月 2016-07-17
  • 打赏
  • 举报
 回复
格式化后，必须重新调整“插入点”。 因此我在3楼说了，顺序输入比较好处理点儿，如果“乱序输入”，处理起来特别麻烦。
舉杯邀明月 2016-07-17
  • 打赏
  • 举报
 回复
引用 6 楼 iamsilly 的回复:
各位大哥，我的要求不知道你们是否看清楚了，我要求在text1这个控件中 1.录入的时候自动显示千分位。 2.如果有字符自动不能录入。 3.如果上面你们那段代码可以使用，那么那段代码应该放在哪个事件中，我放在text1_keypress里面,录入数字的时候顺序会被打乱。 比如录入123456,刚录入12，text1就显示20,001.00。我总感觉你们没有认真看我的需求。我是那种需要你们给我仔细一点，比较笨的那种，多谢！
我可是认真看了的！
iamsilly 2016-07-17
  • 打赏
  • 举报
 回复
各位大哥，我的要求不知道你们是否看清楚了，我要求在text1这个控件中 1.录入的时候自动显示千分位。 2.如果有字符自动不能录入。 3.如果上面你们那段代码可以使用，那么那段代码应该放在哪个事件中，我放在text1_keypress里面,录入数字的时候顺序会被打乱。 比如录入123456,刚录入12，text1就显示20,001.00。我总感觉你们没有认真看我的需求。我是那种需要你们给我仔细一点，比较笨的那种，多谢！
一如既往哈 2016-07-17
  • 打赏
  • 举报
 回复
楼主在自寻烦恼。
一如既往哈 2016-07-17
  • 打赏
  • 举报
 回复
正则，只会一点皮毛，来个笨法吧，好像也不是很麻烦哦 
Option Explicit
Private Sub Text1_Change()
    Text1Change Text1
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
    Select Case KeyAscii
    Case 48 To 57, 8, 46
    Case 43, 45 '+/-   正负号只能在第1位
        If Text1.SelStart > 0 Then KeyAscii = 0
    Case Else
        KeyAscii = 0
    End Select
End Sub
Private Sub Text1Change(bText As TextBox)
    With bText
        If Not IsNumeric(.Text) Then Exit Sub
        Dim iPos As Integer, w1 As String
        Dim pT As String, i As Integer
        iPos = .SelStart '''记录光标位置
        i = InStr(iPos + 1, .Text, ",") ''找到光标后面的,
        If i = 0 Then i = InStr(.Text, ".") ''小数点的位置
        If i = 0 Then i = Len(.Text) + 1 '''整个字符串
        pT = Left$(.Text, i - 1) '''得到可能发生变化的部分
        w1 = Format$(Replace(pT, ",", ""), "##,###")
        If Left$(pT, 1) = "+" Then w1 = "+" & w1 '''补充+(在格式化时会丢掉的)
        .Text = w1 & Right$(.Text, Len(.Text) - i + 1) '''更新格式化后的内容
        .SelStart = iPos + Len(w1) - Len(pT) ''计算新光标位置
    End With
End Sub
'
..
无·法 2016-07-17
  • 打赏
  • 举报
 回复
引用 15 楼 Chen8013 的回复:
如果正、负号输在中间，你还是没把它处理掉的啊。
这种的就不管他啦，谁知道人家是要输入1+1想让他变成2还是干嘛的呢。。
舉杯邀明月 2016-07-17
  • 打赏
  • 举报
 回复
如果正、负号输在中间，你还是没把它处理掉的啊。
无·法 2016-07-17
  • 打赏
  • 举报
 回复 
Private Sub Text1_Change()
    setFormat Text1
End Sub
'传入需要设置的文本框的name即可
Private Sub setFormat(objTxt As TextBox)
    Dim v, strNew$, intLenDel%, s1$, s1_new$, s2$, intSelStart%
    Dim reg As Object
    Set reg = CreateObject("vbscript.regExp")
    reg.Global = True
    reg.Pattern = "[^\d\.+-.]" '匹配合法之外的字符的表达式删除掉
    strNew = reg.Replace(objTxt.Text, "")
    If strNew = "" Then
        objTxt.Text = ""
        Exit Sub
    End If
    v = Split(strNew, ".")
    intLenDel = Len(objTxt.Text) - Len(strNew)
    s1 = Replace(v(0), ",", "")
    If UBound(v) > 0 Then s2 = "." & v(1)
    reg.Pattern = "(\d{3})"
    s1_new = StrReverse(reg.Replace(StrReverse(s1), "$1,")) '每隔3数字加逗号
    reg.Pattern = "(\+|-),"
    s1_new = reg.Replace(s1_new, "$1")
    If Left(s1_new, 1) = "," Then s1_new = Mid(s1_new, 2)
    intSelStart = objTxt.SelStart
    objTxt.Text = s1_new & s2
    objTxt.SelStart = intSelStart + Len(s1_new) - Len(v(0)) - intLenDel
End Sub
好啦，打了补丁了，正负这么变态的都能处理了。非法字符也都一句话删除了。
加载更多回复（6）
js数字类型转换为千分位分隔的函数及保留小数位
//處理千位分隔函數（整數FormatNumber(intInput,0)保留三位小數FormatNumber(intInput,3)） 　　//intInput表示输入的参数，intLength表示保留的小数位         function FormatNumber(intInput,intLength) {             //将输入参数转换为字符串形式
文本框输入数字显示千位分隔符，大写提示
//文本框 //js代码   --------------------start----------------------------- //文本框输入数字时，调用以下两个方法 $('#numId').bind('input propertychange', function() { $('#numId').val(thousandBitSeparator($(this).v
如何对input框的值进行小数位数的保留，保留几位小数的方法。
在最近开发的时候，遇到这样的需求，对input框内的值进行小数位数的保留，最多保留6位小数。我们可以通过对值内的小数点的索引的判断，获取小数的索引，然后进行保留小数位数。通过以上的方法就可以完美的处理input框保留多尾小数的问题了。
word表格数据处理：如何给长数字添加千位分隔符？
而如果你掌握一些整理数据的小技巧，别人半天的工作量，你只需要10秒，不信，你往下看。第1种方法适合于数据量较少或者数据比较集中的情况，如果数据分散在文档不同的位置，则不适合批量复制粘贴到Excel中来处理。Word中，若有大量相同格式的内容需要处理，都可以用查找和替换来完成。其原理就是Word中的“查找和替换”可以使用正则表达式，而Excel中的“查找和替换”却不行！点击右键，选择【只保留文本】，将Excel中的数据复制粘贴回Word表格中。：继续在【查找和替换】对话框中的【查找内容】中输入：“
个人永久性免费-Excel催化剂功能第80波-按条件查找数字，扩展原生查找功能
Excel的查找替换功能，只能对文本类数据查找较为得力，若需查找数字类型的数据，如查找大于100的数字，就无能为力，此篇Excel催化剂补足其短板。 Excel数据类型知识背景介绍 用好Excel，必不可少的是要对Excel单元格内的数据有数据类型的概念，Excel单元格上的数据，大类上分为文本型和数值型，再加上不太常用到的影响不大的错误类型、逻辑类型。处理好数据是文本类型还...
VB基础类

7,763

社区成员

197,609

社区内容

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章