请高手帮助我修改下千位分隔符的代码

杨帆

　主要是对于整数，不想加.00，如23456只是变为23,456  而不是23,456.00   谢谢大家了.

原代码如下，

Sub 千位分隔符()
    Dim i As Range, Acell As Cell, CR As Range, YN As String
    On Error Resume Next
    Application.ScreenUpdating = False
    If Selection.Type = 2 Then
        For Each i In Selection.Words
            If i Like "#####*" = True Then
                If i.Next Like "." = True And i.Next(wdWord, 2) Like "#*" = True Then
                    i.SetRange Start:=i.Start, End:=i.Next(wdWord, 2).End
                    i = Format(i, "Standard")
                Else
                    i = Format(i, "Standard")
                End If
            End If
        Next i
    ElseIf Selection.Type = 5 Then
        For Each Acell In Selection.Cells
            Set CR = ActiveDocument.Range(Acell.Range.Start, Acell.Range.End - 1)
            If CR Like "#####*" = True Then
                If CR Like "#####.#*" = True Then
                    YN = Format(CR, "Standard")
                    CR.Text = YN
                Else
                    YN = Format(CR, "Standard")
                    CR.Text = YN
                End If
            End If
        Next Acell
    Else
        MsgBox "没有选定文本，请按Ctrl+A选择整篇审计报告！", vbOK + vbInformation
    End If
    Application.ScreenUpdating = True
End Sub

[此贴子已经被作者于2008-1-17 16:43:06编辑过]

杨帆

麻烦大家了

[此贴子已经被作者于2008-1-17 16:27:48编辑过]

守柔

请参考:

http://club.excelhome.net/viewthread.php?tid=258775&replyID=961086&skin=0

http://club.excelhome.net/viewthread.php?tid=258775&replyID=961086&skin=0

杨帆

谢谢斑竹了

但我对ＶＢＡ不太了解，不知道如果把下面的加在上面哪个地方

好象不太一样啊

QUOTE:

以下是引用chylhr在2007-8-10 17:18:11的发言：

守兄不在，我替他解答，有不妥的地方守兄再更正：

将原代码myRange = VBA.Format(myValue, "Standard")改为以下代码即可

   If Len(Str(myValue)) = Len(Str(Int(myValue))) Then
       myRange = VBA.Format(myValue, "###,###,###,###,###")
   Else
       myRange = VBA.Format(myValue, "Standard")
   End If

谢谢chyhr！

这段时间太忙，以至于几乎无心上网。

这样改更好一些：

  '转为千分位格式
            myRange.Text = Replace(Format(myValue, "Standard"), ".00", "")
            GoTo NextFind    '转到指定行

[此贴子已经被作者于2008-1-17 17:06:50编辑过]

守柔

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2008-1-17 17:16:41
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0303^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'显式变量声明
Option Explicit
Sub StandardNumber()
'本代码旨在解决WORD中数据转化为千分位
'数据限定要求:-922,337,203,685,477.5808 到 922,337,203,685,477.5807
'转化结果1000以上数据以千分位计算,小数点右侧保留二位小数;1000以下数据不变
    Dim myRange As Range, i As Byte, myValue As Currency
    On Error Resume Next '忽略错误
    Application.ScreenUpdating = False   '关闭屏幕更新
    '定义myRange为主文档文字部分
NextFind:     Set myRange = ActiveDocument.Content
    With myRange.Find    '查找
        .ClearFormatting    '清除格式
        .Text = "[0-9]{4,15}"    '4到15位数据
        .MatchWildcards = True    '使用通配符
        Do While .Execute    '每次成功查找
            i = 2    '起始值为2
            '如果是有小数点
            If myRange.Next(wdCharacter, 1) = "." Then
                '进行一个未知循环
                While myRange.Next(wdCharacter, i) Like "#"
                    i = i + 1    '只要是[0-9]任意数字则累加
                Wend
                '重新定义RANGE对象
                myRange.SetRange myRange.Start, myRange.End + i - 1
            End If
            '保险起见转换为数据,也可省略
            myValue = VBA.Val(myRange)
            '转为千分位格式
            myRange = VBA.Format(myValue, "Standard")
            myRange.Text = Replace(Format(myValue, "Standard"), ".00", "")
            GoTo NextFind    '转到指定行
        Loop
    End With
    '恢复屏幕更新
    Application.ScreenUpdating = True
End Sub
'----------------------

杨帆

谢谢斑竹，真是太厉害了．但是我还有个问题，根据GB/T15835—1995《出版物上数字用法的规定》规定：“专业性科技出版物的分节法：从小数点起，向左和向右每三位数字一组，组间空四分之一个汉字(二分之一个阿拉伯数字)的位置。非专业性科技出版物如排版留四分空有困难，可仍采用传统的以千分撇‘,’分节的办法。小数部分不分节。四位以内的整数也可以不分节。”

为了四位内整数不分节，我把

 .Text = "[0-9]{4,15}"    '4到15位数据

改为了

 .Text = "[0-9]{5,15}"    '5到15位数据

但是这样改就存在这样一个问题,四位非整数的,也不加千分位了

如:其他收入7017.56元,就没有改变

之所以要做到四位整数不分位,一是上面的规定,二是我们的报告中有2008年等文字,年份不可以加分隔位的.

请问热心的斑竹,这个问题如果解决呢.

十分感谢,对我们工作帮助很大.

[此贴子已经被作者于2008-1-17 17:32:48编辑过]

杨帆

应该还使用

 .Text = "[0-9]{4,15}"    '4到15位数据

但是需要加一个判断是否是整数的语句，如果是则不加分隔符，哪位高手能帮我一下，我学ＶＦＰ的，不会ＶＢＡ谢谢

[此贴子已经被作者于2008-1-17 19:06:39编辑过]

守柔

QUOTE:

以下是引用杨帆在2008-1-17 18:54:01的发言：

应该还使用

 .Text = "[0-9]{4,15}"    '4到15位数据

但是需要加一个判断是否是整数的语句，如果是则不加分隔符，哪位高手能帮我一下，我学ＶＦＰ的，不会ＶＢＡ谢谢

只是根据楼主的要求,修改了一下代码,请测试:

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2008-1-18 6:09:30
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0305^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'显式变量声明
Option Explicit
Sub StandardNumber()
'本代码旨在解决WORD中数据转化为千分位
'数据限定要求:-922,337,203,685,477.5808 到 922,337,203,685,477.5807
'转化结果1000以上数据以千分位计算,小数点右侧保留二位小数;1000以下数据不变
'"2008"不被转换,但如"2008."将被转换为"2,008","2008.0"将被转换为"2,008.0"
    Dim myRange As Range, i As Byte, myValue As Currency, myString As String
    On Error Resume Next    '忽略错误
    Application.ScreenUpdating = False   '关闭屏幕更新
    '定义myRange为主文档文字部分
    Set myRange = ActiveDocument.Content
NextFind:     With myRange.Find    '查找
        .ClearFormatting    '清除格式
        .Text = "[0-9.]{4,15}"    '4到15位数据
        .MatchWildcards = True    '使用通配符
        If .Execute = True Then
            '保险起见转换为数据,也可省略
            If VBA.IsNumeric(myRange.Text) Then
                myValue = VBA.Val(myRange.Text)
                If Len(myRange.Text) <> 4 Then
                    '转为千分位格式
                    myString = VBA.Format(myValue, "Standard")
                    myRange.Text = Replace(myString, ".00", "")
                End If
            End If
            myRange.SetRange myRange.End, ActiveDocument.Content.End
            GoTo NextFind    '转到指定行
        End If
    End With
    '恢复屏幕更新
    Application.ScreenUpdating = True
End Sub
'----------------------

杨帆

刚才测试了一下，应该是没问题

十分感谢斑竹，我将在我们系统内公布这个做法，整个审计系统都会感谢您的．

ggmmlol

以下代码，对文档全部内容的整数添加千位分节符。

其逻辑是：
首先把所有数字字符添加删除线；
再把小数部分或表示年份的数值取消删除线；
对有删除线的数字添加千位分节符；
最后，把数字的删除线取消。

1. Sub KilobitSeparator()
   
2.     Selection.HomeKey Unit:=wdStory
   
3.     With Selection.Find
   
4.         .ClearFormatting
   
5.         .Replacement.ClearFormatting
   
6.         .Replacement.Font.StrikeThrough = True
   
7.         .Text = "[0-9]@[!0-9]"
   
8.         .Replacement.Text = ""
   
9.         .Forward = True
   
10.         .Wrap = wdFindContinue
    
11.         .Format = True
    
12.         .MatchCase = False
    
13.         .MatchWholeWord = False
    
14.         .MatchByte = False
    
15.         .MatchAllWordForms = False
    
16.         .MatchSoundsLike = False
    
17.         .MatchWildcards = True
    
18.         .Execute Replace:=wdReplaceAll
    
19.         
    
20.         .ClearFormatting
    
21.         .Replacement.ClearFormatting
    
22.         .Replacement.Font.StrikeThrough = False
    
23.         .Text = ".[0-9]{1,}" '排除小数部分
    
24.         .Replacement.Text = ""
    
25.         .Execute Replace:=wdReplaceAll
    
26.         
    
27.         .Text = "[0-9]{1,}年" '排除表示年份的数值
    
28.         .Execute Replace:=wdReplaceAll
    
29.         
    
30.         
    
31.         .ClearFormatting
    
32.         .Replacement.ClearFormatting
    
33.         .Replacement.Font.StrikeThrough = True
    
34.         .Text = "[0-9]."
    
35.         .Replacement.Text = ""
    
36.         .Execute Replace:=wdReplaceAll
    
37.         
    
38.         .ClearFormatting
    
39.         .Font.StrikeThrough = True
    
40.         .Replacement.ClearFormatting
    
41.         .Text = "([0-9])([0-9]{3}[!0-9])"
    
42.         .Replacement.Text = "\1,\2"
    
43.         .Format = True
    
44.         
    
45.         For i = 1 To 9 '最大可对30位整数添加千位分隔符
    
46.             .Execute Replace:=wdReplaceAll
    
47.         Next
    
48.         
    
49.         .ClearFormatting
    
50.         .Replacement.ClearFormatting
    
51.         .Replacement.Font.StrikeThrough = False
    
52.         .Text = "[0-9]@[!0-9]"
    
53.         .Replacement.Text = ""
    
54.         .Execute Replace:=wdReplaceAll
    
55.     End With
    
56. End Sub

复制代码