我试图在这里找出一些代码,我现在已经查看了一些网站,包括这里,它几乎可以工作,但很可能是我的数据表导致了这个问题。
这个: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 将始终是“总计:”。
这个循环的问题是每组数据之间都有空白,所以它找到了第一个“总计:”但找不到我的第一个值,因为它在大约 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
我附上了几乎可以工作的代码,但找不到我的第一个值。
最佳答案
您可以使用 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。
关于excel - 在两个值 VBA 之间复制行并粘贴到新的工作表循环,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/47584476/