Question

我想在这里找出一些代码，我现在已经看了几个网站，包括这里，它几乎可以工作，但很可能是我的数据表导致了这个问题。这：Search for two values and copy everything in between in a loop 而这：I need code to copy between two rows and paste into the another sheet with our giving any values?

可能会有效，但无法找到第一个值。让我解释一下。

我有一个网站导出的报告，它将总数分为名称（值1），然后将总数分为:(单词2）。

我需要做的只是复制和粘贴，其中值1符合，值2总是＆＃34;总计为：＆＃34;。这个循环的问题在于每组数据之间存在空白，因此它找到了第一个＆＃34;总计：＆＃34;但找不到我的第一个值，因为它介于约20个空白单元格之间。（19组数据 - 每组之间有一个空行）。

如何复制修复上面的代码，使其不断向下行，无论空白找到第一个值，然后找到第二个值。将该范围复制到新工作表，并使用新值1？

重复此操作

Sub MoveRows()
Dim rownum As Integer
Dim colnum As Integer
Dim startrow As Integer
Dim endrow As Integer

rownum = 1
colnum = 1

 With ActiveWorkbook.Worksheets("Sheet1")
    Do
       If .Cells(rownum, 1).Value = "LIFEC - Supp Life - Ch" Then
          startrow = rownum
       End If
       rownum = rownum + 1
    Loop Until .Cells(rownum, 1).Value = "Totals for:"
    endrow = rownum
    ActiveWorkbook.Worksheets("Sheet1").Range(startrow & ":" & endrow).Copy

 End With
 ActiveWorkbook.Worksheets("Sheet2").Paste




End Sub


Sub Star123()
Dim rownum As Long
Dim colnum As Long
Dim startrow As Long
Dim endrow As Long
Dim lastrow As Long
rownum = 1
colnum = 1
lastrow = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
With ActiveWorkbook.Worksheets("Sheet1").Range("A1:A" & lastrow)


For rownum = 1 To lastrow
 Do
    If .Cells(rownum, 1).Value = "LIFEC - Supp Life - Ch" Then
       startrow = rownum
    End If

    rownum = rownum + 1


 If (rownum > lastrow) Then Exit For

 Loop Until .Cells(rownum, 1).Value = "Totals for:"
 endrow = rownum
 rownum = rownum + 1

 Worksheets("Sheet1").Range(startrow & ":" & endrow).Copy


 Sheets("Sheet2").Select
 Range("A1").Select
 ActiveSheet.Paste


 Next rownum
 End With
 End Sub

我附上了几乎可以工作的代码，但找不到我的第一个值。

Answer 1

您可以使用类似以下内容的Find方法：

Dim s As Range, e As Range
With Sheet1 'or this can be any other sheet where you search
    Set r = .Range("A:A").Find("Whatever you want found")
    If Not r Is Nothing Then
        Set e = .Range("A:A").Find("The other end", r)
        If Not e Is Nothing Then
            .Range(r, e).EntireRow.Copy Sheet2.Range("A1") 'or to whatever sheet
        End If
    End If
End With

然后，您可以在循环中将其替换为您想要找到的字符串。 HTH。

复制两个值VBA之间的行并粘贴到新的工作表循环

1 个答案: