根据列中的匹配复制行
提问于 2020-11-24 08:26:58
因此，如果行符合某些标准，我希望将它们复制到新的工作表中。
我目前正在使用1条标准测试这一点，因为我怀疑一旦掌握了这个标准，我将能够使用和函数应用多个标准。
标准如下。如果第一列中的值等于第一列中的负值，则将两行复制到一个新工作表中。例如，如果Range("i5") =- Range("i20")，那么将两行复制到新的工作表中。
然而，一旦满足了我的条件，我似乎就无法复制行。见下文
Sub test()
Dim n As Long, i As Long, j As Long
Dim CurrentRow As Long
n = Range("A8").End(xlDown).Row
CurrentRow = CurrentRow + 1
For i = 8 To n
For j = 8 To n
If Range("i" & i) = -Range("i" & j) Then
Sheets("Sheet1").Range(CurrentRow & ":" & CurrentRow) = Sheets("Sheet2").Range(i & ":" & i)
CurrentRow = CurrentRow + 1
Worksheets("Sheet1").Range("A" & CurrentRow) = Range(j & ":" & j)
CurrentRow = CurrentRow + 1
End If
Next j
Next i
End Sub
回答 1
Stack Overflow用户
回答已采纳
发布于 2020-11-24 08:48:05
Sub test()
Dim n As Long, i As Long, j As Long
Dim CurrentRow As Long
Dim Row1 As Range, Row2 As Range
n = Range("A8").End(xlDown).Row
CurrentRow = CurrentRow + 1
For i = 8 To n
For j = 8 To n
If Range("i" & i) > 0 And Range("i" & i) = -Range("i" & j) Then
Worksheets("Sheet2").Range(i & ":" & i).Copy Worksheets("Sheet1").Range(CurrentRow & ":" & CurrentRow)
CurrentRow = CurrentRow + 1
Worksheets("Sheet2").Range(j & ":" & j).Copy Worksheets("Sheet1").Range("A" & CurrentRow)
CurrentRow = CurrentRow + 1
End If
Next j
Next i
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/64990662
复制相关文章
腾讯云开发者
