如何用VBA代码实现目标单元格大批复制

9532

413191246se 发表于 2020-6-11 23:26
楼主，你测试是用你提供的附件吗？你的 Word 版本是多少的？我是 Word2019，测试正常。
另外，楼主，你提 ...

老师，office是2019版。我上传的附件用没问题，到需要实现的表格里就是我8楼回复的那样

9532

413191246se 发表于 2020-6-11 23:33
楼主，在我 Word2019 中用你的附件，用我上传的代码又测试一遍，运行正常！——请重新测试一下。

老师，表格我替换成要用的了，您看一下

413191246se

楼主，我发现，您，又是一个不讲究的人！
原来的附件，表格数有 4 个；现在的附件，表格数有 1 个（看着每页都有表格，但还是一体的，未断开）。
继前几天，我发现一位朋友，是一个不讲究的人，之后，您，又是第二个不讲究的人！
我，我又一次无话可说呀！（附件不一样，运行结果当然不一样了，因为，我可是一个比较讲究的人。）

ming0018

413191246se 发表于 2020-6-12 09:33
楼主，我发现，您，又是一个不讲究的人！
原来的附件，表格数有 4 个；现在的附件，表格数有 1 个（看着每 ...

哈哈，还好，我没看附件，不然气死了！

9532

413191246se 发表于 2020-6-12 09:33
楼主，我发现，您，又是一个不讲究的人！
原来的附件，表格数有 4 个；现在的附件，表格数有 1 个（看着每 ...

代码编写不太懂，还和数量有关啊。想着一页一个表，没什么影响，我描述的可能差了点，老师海涵

413191246se

还好，还好。楼主，不好意思，发了几句牢骚。其实昨晚我重新思考了一下，已经有了答案。那就是，查找“仪表位号”即可，然后下一单元格的值自然就得到了！请试用下面的代码（有无分节符及几个表格都无所谓了，不过，我只测试了前 3 个表格的值是正确的，请 楼主 自行检查吧！）：

1. Sub aaaa单元格批量复制_New()
   
2.     Dim s$, i$
   
3.     With ActiveDocument
   
4.         With .Content.Find
   
5.             .ClearFormatting
   
6.             .Text = "仪表位号"
   
7.             .Forward = True
   
8.             .MatchWildcards = True
   
9.             Do While .Execute
   
10.                 With .Parent
    
11.                     s = .Cells(1).Range.Next.Cells(1).Range.Text
    
12.                     s = Left(s, Len(s) - 2)
    
13.                     i = i & "/" & s
    
14.                 End With
    
15.             Loop
    
16.         End With
    
17.         .Close SaveChanges:=wdDoNotSaveChanges
    
18.     End With
    
19.     Documents.Add.Content.Text = i
    
20.     With ActiveDocument
    
21.         .Content.Find.Execute "/", , , 1, , , , , , "^p", 2
    
22.         .Characters(1).Delete
    
23.     End With
    
24.     ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit
    
25.     MsgBox "处理完毕！文档尚未保存！", 0 + 16
    
26. End Sub

复制代码

9532

413191246se 发表于 2020-6-12 15:05
还好，还好。楼主，不好意思，发了几句牢骚。其实昨晚我重新思考了一下，已经有了答案。那就是，查找“仪表 ...

老师，可以了，完美解决问题。