如何更新单词表？

Question

我正在研究轴承报告。我必须复制并从Excel文件中找到相关的方位数据并将其粘贴到单词表中。我已经计算出代码

1. 要转到word文件中的相关位置，并在所需的word文档中粘贴一些数据。

   Sub CreateNewWordDoc() 
       Dim wrdApp As Word.Application 
       Dim wrdDoc As Word.Document 
       Dim i As Integer 
       Dim arr(12) 
       'Bearing numbers I need to search 
       arr(0) = "(249_L), 38,7 %" 
       arr(1) = "(248_R), 38,7 %" 
       arr(2) = "(249_M), 38,7 " 
       arr(3) = "(3560), 38,7 " 
       arr(4) = "(3550), 38,7 %" 
       arr(5) = "(349_), 38,7 %" 
       arr(6) = "(348_), 38,7 %" 
       arr(7) = "(451), 38,7 %" 
       arr(8) = "(450L), 38,7 " 
       arr(9) = "(450R), 38,7 " 
       arr(10) = "(151), 38,7 %" 
       arr(11) = "(150L), 38,7 %" 
       arr(12) = "(150R), 38,7 %" 
       Set wrdApp = CreateObject("Word.Application") 
       wrdApp.Visible = True 
       'location of my word document 
   
       Set wrdDoc = wrdApp.Documents.Open("E:\ShareDrive_Ruehl\full-flexible-MBS-models_report\example-report\FullFlexibleGearbox - Copy (2).docx") 
       wrdDoc.Activate 
   
       wrdApp.Selection.HomeKey unit:=wdStory 
       'for loop to reach all bearing location 
       For i = 0 To 12 
        With wrdApp.Selection 
         With .Find 
          .ClearFormatting 
          .MatchWildcards = False 
          .MatchWholeWord = False 
          .Text = arr(i) 
          .Execute 
         End With 
         ' Here is where I need to paste my copied data. 
   
         .InsertAfter "I can just paste this shit" 
         .HomeKey unit:=wdStory 
        End With 
       Next 
   End Sub 
   

2. 转到Excel文件中的位置，找到相关的数据，并复制相关的数据，这里是该代码。

   Sub CopyToWord() 
       'Copy the range Which you want to paste in a New Word Document 
       Cells.Find(What:=arr(0), After:=ActiveCell, LookIn:=xlFormulas _ 
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
        MatchCase:=False, SearchFormat:=False).Activate 
       ActiveCell.Offset(2, 0).Range("A1:g8").Select 
       Selection.Copy 
   End Sub 
   

我已经写了两个从Excel中VBA运行这些代码。但现在我必须将第二个代码中的复制数据粘贴到位于第一个代码中的表格中（该位置的位置不是在我找到该单词的位置之后）要去那个位置，我知道代码，可以通过下面给出的图片更好地理解）。

这是我选择单词中我需要替换的数据的代码。我需要写的字相似，替代与复制的数据

Sub pasting() 
    Dim sSample, rResult As String 
    sSample = "(450R), 38,7 % " 

    Set rRange = ActiveDocument.Content 
    Selection.Find.Execute FindText:=sSample, _ 
     Forward:=True, Wrap:=wdFindStop 
    Selection.MoveDown unit:=wdLine, Count:=1 
    Selection.EndKey unit:=wdLine 
    Selection.MoveRight unit:=wdCharacter, Count:=1 
    Selection.EndKey unit:=wdLine 
    Selection.MoveDown unit:=wdLine, Count:=1 

    Selection.MoveDown unit:=wdLine, Count:=5, Extend:=wdExtend 
    Selection.MoveLeft unit:=wdCharacter, Count:=5, Extend:=wdExtend 
    Selection.PasteAndFormat (wdPasteDefault) 
End Sub 

不幸的是，虽然我抄什么，我想我不能够在解决办法的数据。我不知道如何在现有表格中粘贴数据。

这幅图解释得更好。我需要在excel中搜索轴承248_R的数据并粘贴到word中。 这是Word文件

这是Excel文件

Answer 1

Sub CreateNewWordDoc() 
    Dim wrdApp As Word.Application 
    Dim wrdDoc As Word.Document 



    Dim arr(12) 
    'Bearing numbers I need to search 
    arr(0) = "(249_L), 38,7 %" 
    arr(1) = "(248_R), 38,7 %" 
    arr(2) = "(249_M), 38,7 " 
    arr(3) = "(3560), 38,7 " 
    arr(4) = "(3550), 38,7 %" 
    arr(5) = "(349_), 38,7 %" 
    arr(6) = "(348_), 38,7 %" 
    arr(7) = "(451), 38,7 %" 
    arr(8) = "(450L), 38,7 %" 
    arr(9) = "(450R), 38,7 %" 
    arr(10) = "(151), 38,7 %" 
    arr(11) = "(150L), 38,7 %" 
    arr(12) = "(150R), 38,7 %" 

    range2 = 6 


    Set wrdApp = CreateObject("Word.Application") 
    wrdApp.Visible = True 
    'location of my word document 

    Set wrdDoc = wrdApp.Documents.Open("E:\Siemens\FullFlexibleGearbox.docx") 
    wrdDoc.Activate 

    wrdApp.Selection.HomeKey Unit:=wdStory 
    'for loop to reach all bearing location 
    For i = 0 To 12 
      Cells.Find(What:=arr(i), After:=ActiveCell, LookIn:=xlFormulas, _ 
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
       MatchCase:=False, SearchFormat:=False).Activate 
       ActiveCell.Offset(2, 0).Range("A1:G8").Select 
       Application.CutCopyMode = False 
       Selection.Copy 

     With wrdApp.Selection 
      With .Find 
       .ClearFormatting 
       .MatchWildcards = False 
       .MatchWholeWord = False 
       .Text = arr(i) 
       .Execute 
      End With 
      .MoveRight Unit:=wdCharacter, Count:=2 
      .MoveDown Unit:=wdLine, Count:=1 
      .MoveDown Unit:=wdLine, Count:=6, Extend:=wdExtend 
      .MoveLeft Unit:=wdCharacter, Count:=6, Extend:=wdExtend 
      .Paste 
      .HomeKey Unit:=wdStory 



     End With 
    Next 
    End Sub 

感谢您的支持人员。 :)

Answer 2

忘记复制和粘贴。相反，一旦你找到你的数据（在2）将范围分配给变量类型的变量。它现在将成为变量内的一个数组 现在，您可以通过将每个元素分配到表格中的单元格来循环使用 我在工作，因此我无法看到您的图像，但请记住，Word表格中的单元格会被引用为小区（行，列） - 所以你可以写

with Wrdapp.documents(1).tables(1) 
     For x = 0 to ubound(v,1) 
      for y = 0 to ubound(v,2) 
      .cell(x + 1,y + 1).range.text = v(x,y) 
      next y 
     next x 

end with 

到阵列V复制到所述第一表的文档 （在细胞中的+1是因为数组从零计数，但Word表从一个 所以v（0,0）需要去单元格（1,1）

希望这应该让你开始