Loop忘记使用vba

时间:2017-01-13 08:10:11

标签: excel-vba word-vba vba excel

我有这个循环,它要求我插入“n Error Resume next”才能工作。然而,这意味着有时会遗漏一些数据,但并非总是如此。如果我没有第二个textmarke.pastespecial上的“On Error Resume Next”,我得到一个运行时错误'4198'命令失败。我已经尝试寻找我接下来的“n错误恢复”的错误,但我不能。有人有任何建议吗?

   Dim rownum As Integer
   Dim colnum As Integer
   Dim startrow As Integer
   Dim endrow As Integer

   ' Defining the row and colunm to search for the desired cells

    rownum = 1
    colnum = 2

   ' Find everything from start_of_text to end_of_text
    On Error Resume Next

    With ThisWorkbook.Worksheets("Template-Referenz-Produkte")
    For rownum = 1 To 10000
       Do
          If .Cells(rownum, 2).Value = "Start_of_text" Then
             startrow = rownum + 1 ' Add 1 to the row number of "Start_of_text"
          End If
          rownum = rownum + 1

       If (rownum > 10000) Then Exit For

       Loop Until .Cells(rownum, 2).Value = "End_of_text"
       endrow = rownum - 1 ' Minus 1 to the cell number of "End_of_text"

       'Copy everything from startrow until endrow
       ThisWorkbook.Worksheets("Template-Referenz-Produkte").Range("B" & startrow & ":B" & endrow).Copy

       'Paste the copied reference product name from excel into word and format
       Set textmarke = doc.Bookmarks(Book).Range
       textmarke.PasteSpecial
       doc.Bookmarks.Add Book, textmarke 'Create a new bookmark bellow the previous one

    ' Find everything from start_of_table to end_of_table
       Do
          If .Cells(rownum, 2).Value = "Start_of_table" Then
             startrow = rownum + 1 ' Add 1 to the row number of "Start_of_table"
          End If
          rownum = rownum + 1

       If (rownum > 10000) Then Exit For

       Loop Until .Cells(rownum, 2).Value = "End_of_table"
       endrow = rownum - 1 ' Minus 1 to the cell number of "End_of_table"

       'Copy everything between start_of_table to end_of_table
       ThisWorkbook.Worksheets("Template-Referenz-Produkte").Range("B" & startrow & ":E" & endrow).Copy

       'Paste the copied reference product table from excel into word and format
       Set textmarke = doc.Bookmarks(Book).Range
       textmarke.PasteSpecial
       doc.Bookmarks.Add Book, textmarke 'Create a new bookmark bellow bellow the previous one

    Next rownum
    End With

0 个答案:

没有答案
相关问题