如何通过Excel的vba将word中的指定位置的数字设置上标

batmanbbs

嗯，WPS下直接做不到，但是可以采用折中的方法，但是很麻烦，而且还存在和WORD的兼容性。
PS：你在标题和一楼也没有说是WPS啊

叮盯当

batmanbbs 发表于 2023-7-1 16:54
嗯，WPS下直接做不到，但是可以采用折中的方法，但是很麻烦，而且还存在和WORD的兼容性。
PS：你在标题和 ...

不知道你的折中的方法是什么，看你删除多一行的内容启发，我也折中了一个，先按1列的方式粘贴过来，再定位需要上标的数字
With .cell(i, 2).Range
        x = Application.Find("×10", .Text)
        While IsNumeric(.Characters(x + 3))
          .Characters(x + 3).Font.Superscript = True
          x = x + 1
        Wend
End With

batmanbbs

叮盯当 发表于 2023-7-1 18:02
不知道你的折中的方法是什么，看你删除多一行的内容启发，我也折中了一个，先按1列的方式粘贴过来，再定 ...

这样很好。因为COPY和PASTE两个方法执行时需要时间，非常不保靠，一般需要加入延时才可以。所以直接赋值的方法是最好的，然后再根据实际需求修改格式。

batmanbbs

叮盯当 发表于 2023-7-1 18:02
不知道你的折中的方法是什么，看你删除多一行的内容启发，我也折中了一个，先按1列的方式粘贴过来，再定 ...

1. Sub 带格式复制单元格内容到WORD文档()
   
2. '
   
3. ' For WORD/WPS：赋值后再修改上标
   
4. '
   
5.     Dim myWord, myDoc As Object
   
6.     Dim pos%
   
7.     Set myWord = CreateObject("Word.Application")
   
8.     myWord.Visible = True
   
9.     Set myDoc = myWord.Documents.Open(ThisWorkbook.Path & "\1.doc")
   
10.     With myDoc.Tables(1)
    
11.         For i = 2 To 5
    
12.             .Cell(i, 1).Range.Text = Cells(i, 1)
    
13.             .Cell(i, 2).Range.Text = Cells(i, 2)
    
14.             With .Cell(i, 2).Range
    
15.                 pos = InStr(.Text, "×10") + 3
    
16.                 If pos > 3 Then
    
17.                     While IsNumeric(.Characters(pos))
    
18.                         .Characters(pos).Font.Superscript = True
    
19.                         pos = pos + 1
    
20.                     Wend
    
21.                 End If
    
22.             End With
    
23.         Next
    
24.     End With
    
25.     Set myDoc = Nothing
    
26.     Set myWord = Nothing
    
27. End Sub

复制代码

叮盯当

batmanbbs 发表于 2023-7-2 09:50

一个格子里有多处就不好用了，应该还是要正则表达式来更方便，可惜还不会

batmanbbs

叮盯当 发表于 2023-7-3 11:54
一个格子里有多处就不好用了，应该还是要正则表达式来更方便，可惜还不会

需要你的公式才行，肯定是X10后面2位数字吗？
PS：不一定用正则，用WORD自带的查找替换也行，主要还是看公式及其位置。而且如果这样操作，还不如在WORD中打开EXCEL复制粘贴，因为更多的操作是在WORD中进行的。

batmanbbs

叮盯当 发表于 2023-7-3 11:54
一个格子里有多处就不好用了，应该还是要正则表达式来更方便，可惜还不会

代码是X10[1-2位数字上标]，自己可以酌情修改

1. Sub 复制EXCEL单元格内容到WORD文档()
   
2. '
   
3. ' For WORD/WPS：赋值后再修改上标
   
4. '
   
5.     Dim myWord, myDoc As Object
   
6.     Dim pos%
   
7.     Set myWord = CreateObject("Word.Application")
   
8.     myWord.Visible = True
   
9.     Set myDoc = myWord.Documents.Open(ThisWorkbook.Path & "\1.doc")
   
10.     With myDoc.Tables(1)
    
11.         For i = 2 To 5
    
12.             .Cell(i, 1).Range.Text = Cells(i, 1)
    
13.             .Cell(i, 2).Range.Text = Cells(i, 2)
    
14.         Next
    
15.         With .Range.Find
    
16.             .ClearFormatting
    
17.             .Text = "×10[0-9]{1,2}"
    
18.             .Wrap = wdFindStop
    
19.             .Forward = True
    
20.             .MatchWildcards = True
    
21.             Do While .Execute
    
22.                 rStart = .Parent.Start + 3
    
23.                 rEnd = .Parent.End
    
24.                 myDoc.Range(rStart, rEnd).Font.Superscript = True
    
25.             Loop
    
26.         End With
    
27.     End With
    
28.     Set myDoc = Nothing
    
29.     Set myWord = Nothing
    
30. End Sub

复制代码

叮盯当

batmanbbs 发表于 2023-7-3 14:08
代码是X10[1-2位数字上标]，自己可以酌情修改

Excel表格里的能搞吗

batmanbbs

叮盯当 发表于 2023-7-4 21:05
Excel表格里的能搞吗

对EXCEL不熟啊，你怎么不去EXCEL专版提问啊^_^

叮盯当

batmanbbs 发表于 2023-7-4 21:18
对EXCEL不熟啊，你怎么不去EXCEL专版提问啊^_^

突然联想到的，之前表格里的都是分散录入的数据，对每次录入来说设置上标的操作不多