WORD表格内的数值批量替换

woyaofacai

WORD文档中有批量的表格，表格中部份负值数字格为-123.45，如果出现类同格式的数字格式转换为（123.45） 项 目.rar (30.46 KB, 下载次数: 38)

2020-2-16 14:52 上传

点击文件名下载附件

，能否用VBA批量替换所有表格内的值的格式？

excel玉米

见下面代码：
Sub NUM_change()
  Dim i%
  Dim tb As Table
  Dim doc As Document
  Set doc = ActiveDocument
  For Each tb In doc.Tables
    For i = 2 To tb.Rows.Count
       If Val(tb.Cell(i, 2).Range) < 0 Then
           tb.Cell(i, 2).Range.Find.Execute findText:="-", ReplaceWith:="", Replace:=wdReplaceAll
           tb.Cell(i, 2).Range = "(" & Left(tb.Cell(i, 2).Range, Len(tb.Cell(i, 2).Range) - 2) & ")"
       End If
    Next
  Next
End Sub

woyaofacai

excel玉米 发表于 2020-2-17 12:51
见下面代码：
Sub NUM_change()
  Dim i%

大侠，你好，如果表格有些为2列，有些3列，最终多时7列，执行上述代码运行后只有第二列才可以，其他列没有变化，如就是说可否考虑一下表格列数不等的情况下达到要求呢？

厄米算符∫

自己加一个循环就可以了
Sub NUM_change()
  Dim i%
  Dim tb As Table
  Dim doc As Document
  Set doc = ActiveDocument
  For Each tb In doc.Tables
    For i = 2 To tb.Rows.Count
For j=1 to 7
       If Val(tb.Cell(i, j).Range) < 0 Then
           tb.Cell(i, j).Range.Find.Execute findText:="-", ReplaceWith:="", Replace:=wdReplaceAll
           tb.Cell(i, j).Range = "(" & Left(tb.Cell(i, j).Range, Len(tb.Cell(i, j).Range) - 2) & ")"
       End If
next
    Next
  Next
End Sub

没有测试，自己测试一下

excel玉米

改成这样吧。 For j=1 to tb.columns.count  从左至右，如果只是单纯for j=1 to 7,可能会出错。因为表的大小不完全是7列。
Sub NUM_change()
  Dim i%
  Dim tb As Table
  Dim doc As Document
  Set doc = ActiveDocument
  For Each tb In doc.Tables
    For i = 2 To tb.Rows.Count
      For j=1 to tb.columns.count
       If Val(tb.Cell(i, j).Range) < 0 Then
           tb.Cell(i, j).Range.Find.Execute findText:="-", ReplaceWith:="", Replace:=wdReplaceAll
           tb.Cell(i, j).Range = "(" & Left(tb.Cell(i, j).Range, Len(tb.Cell(i, j).Range) - 2) & ")"
       End If
      next
    Next
  Next
End Sub

woyaofacai

完美解决，谢谢                        

凌空一羽

Sub lkyy()
Dim doc As Document
Set doc = Word.ActiveDocument
With doc.Content
    .Find.Execute "-([0-9]{1,3},[0-9]{3},[0-9]{3}.[0-9]{2})", , , 1, , , , , , "(\1)", 2
    .Find.Execute "-([0-9]{1,3},[0-9]{3}.[0-9]{2})", , , 1, , , , , , "(\1)", 2
End With
End Sub

excel玉米

凌空一羽 发表于 2020-2-18 18:05
Sub lkyy()
Dim doc As Document
Set doc = Word.ActiveDocument

凌老师的代码非常简练，吾辈当学习之。谢谢凌老师提供！刚才验证了下代码，建议修改如下，无使有错漏。
Sub lkyy()
Dim doc As Document
Set doc = Word.ActiveDocument
With doc.Content
    .Find.Execute "-([0-9]{1,3},[0-9]{3},[0-9]{3}.[0-9]{1,2})", , , 1, , , , , , "(\1)", 2
    .Find.Execute "-([0-9]{1,3},[0-9]{3}.[0-9]{1,2})", , , 1, , , , , , "(\1)", 2
    .Find.Execute "-([0-9]{1,3}.[0-9]{1,2})", , , 1, , , , , , "(\1)", 2
End With
End Sub

woyaofacai

excel玉米 发表于 2020-2-19 12:26
凌老师的代码非常简练，吾辈当学习之。谢谢凌老师提供！刚才验证了下代码，建议修改如下，无使有错漏。
...

好精简的代码，如果条件变换一下，在整个WORD文档中我只要第8页才执行上面的替换代码，前面表格保留原来的内容和格式，试过没有成功

gbgbxgb

woyaofacai 发表于 2020-2-22 22:23
好精简的代码，如果条件变换一下，在整个WORD文档中我只要第8页才执行上面的替换代码，前面表格保留原来 ...

有这么复杂么？试试下列代码：

1. Sub kkk()
   
2.     Dim myTbl As Table, theStr$, reg As Object, theCell As Cell
   
3.     '
   
4.     Set reg = CreateObject("VBScript.RegExp")
   
5.     With reg
   
6.         .Pattern = "-(\d+(,\s*\d+)*(.\d+)?)"
   
7.         .Global = True
   
8.         For Each myTbl In ActiveDocument.Tables
   
9.             For Each theCell In myTbl.Range.Cells
   
10.                 theStr = theCell.Range.Text
    
11.                 theStr = Left(theStr, Len(theStr) - 2)
    
12.                 If reg.test(theStr) Then
    
13.                     theStr = .Replace(theStr, "($1)")
    
14.                     theCell.Range.Text = theStr
    
15.                 End If
    
16.             Next theCell
    
17.         Next myTbl
    
18.     End With
    
19. The_Exit:
    
20.     Set reg = Nothing
    
21. End Sub

复制代码