将所选内容中的格式化数据从 Excel 移动到 Word 表格中

Question

我想将数据从 Excel 移动到 Word 表格中。我们希望保留现有 Word 表格的格式，并且仅将数据移动到每个单元格中。涉及的数据有美元（#,###）、每股（#.##）和百分比（#.#%）。

在 Excel 中，该数字可能为 80.0%，但在 Word 中显示为 0.8。当我使用

.Text("[0-9].[0-9]")

函数时，它会进入无限循环。我需要的东西要么只选择精确的标准（即 #.#），而不是更多的单位，要么从 Excel 转录时，使 80.0% 这样的数字显示为 0.80 或 80.0%。

我了解复制和粘贴的特殊功能，但要么表格格式与原始格式不完全匹配，要么在逐个单元格链接时，刷新时间太长。还在不同的地方尝试过使用星号作为通配符。

我确实看到了有关 RegEx 的一些内容，看起来它可能有助于满足严格的标准。

Sub Seg1_QTD()  
Dim objExcel As New Excel.Application 
Dim exWb As Excel.Workbook 
Dim ExcelFileName As String 
Dim i As Integer   

ExcelFileName = "LocationHere" 
Set exWb = objExcel.Workbooks.Open("Excel.xlsm", ReadOnly:=True, CorruptLoad:=xlExtractData)  

'Change the # for ActiveDocument.Tables dependent on quarter 
If exWb.Sheets("READ ME").Range("B8") = "Q1" Then 
  i = 2 
Else 
  i = 3  
End If  

'There are other lines, I included one to simplify 
With ActiveDocument.Tables(i) .Cell(5, 3).Range.Text = exWb.Sheets("Segment").Cells(7, 5)  
End With  

exWb.Close SaveChanges:=False  
Set exWb = Nothing   
'===================FORMATTTING==================================  

Dim rngOriginal As Range 
Dim strTemp As String  

Application.ScreenUpdating = False   

'Set range of table 
Set rngOriginal = ActiveDocument.Range( \_ Start:=ActiveDocument.Tables(i).Cell(5, 3).Range.Start, \_ End:=ActiveDocument.Tables(i).Cell(23, 6).Range.End) 

rngOriginal.Select   
With Selection.Find 
.Wrap = wdFindStop 
.ClearFormatting 
.Text = "\[0-9\].\[0-9\]"  
.Replacement.Text = "" 
.Forward = True 
.Format = False 
.MatchCase = False 
.MatchWholeWord = False 
.MatchAllWordForms = False 
.MatchSoundsLike = False 
.MatchWildcards = False   

Do While .Execute 
strTemp = Val(Selection.Range) 
Selection.Range = Format((strTemp), "0.0%")  
Selection.Collapse wdCollapseEnd 
rngOriginal.Select 
Loop 
End With 

i = 0   

End Sub

Answer 1

假设数字 0.8 在

rngOriginal

内的单元格中。

• 使用

  .Text = "[0-9].[0-9]"

  搜索数字，找到包含 0.8 的单元格。然后将数字 0.8 更新为 80.0%。循环的第一次迭代成功。

• rngOriginal.Select

  更改

  Selection

  对象。
• 在下一次

  Do While .Execute

  运行期间，它会从

  beginning

  的

  rngOriginal

  中搜索数字。
• 它将

  0.0

  定位在 80.0% 处，单元格更新为

  80.0%%

  (0.0 => 0.0%)，并继续搜索...
• 这会导致无限循环。

---

• 下面的代码是查找数字并更新百分比的示例。

Option Explicit
Sub SearchPercent()
Dim rngOriginal As Range
Dim strTemp As String, iEnd As Long
'Set range of table
Set rngOriginal = ActiveDocument.Range( _
    Start:=ActiveDocument.Tables(1).Cell(5, 3).Range.Start, _
    End:=ActiveDocument.Tables(1).Cell(23, 6).Range.End)
    iEnd = rngOriginal.End
    With rngOriginal.Find
        .Wrap = wdFindStop
        .ClearFormatting
        .Text = "[0-9].[0-9]"
        .Replacement.Text = ""
        .Forward = True
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        Do While .Execute
            If rngOriginal.Start > iEnd Then Exit Do
            strTemp = Val(rngOriginal.Text)
            rngOriginal.Text = Format((strTemp), "0.0%")
            rngOriginal.Collapse wdCollapseEnd
        Loop
    End With
End Sub