时间戳

首页 > 解决方案 > 如果单元格 A1 大于 B1，则将行剪切并粘贴到第一个空行

excel - 如果单元格 A1 大于 B1，则将行剪切并粘贴到第一个空行

问题描述

如果 I1-I14 列中的单元格大于 J1-J14 列中的单元格，我想剪切整行并将值粘贴到第一个空行。（从第 16 行开始。）

如果单元格 i 大于单元格 j，则剪切行并将值粘贴到第一个空行（本例中为第 16 行）
在此处输入图像描述

此代码仅粘贴在第一行：

Sub Knapp6_Klicka()
    
    Dim i As Long
    Dim j As Long
    
    j = 1
    For i = 3 To 500
        If Cells(i, 9).Value > Cells(i, 10).Value Then
            Cells(i, 12).EntireRow.Cut Sheets("Blad1").Range("A" & j)
        j = j + 1
        End If
    Next i
        
End Sub

我试图将糊状物与两种不同的解决方案结合起来。

像这样，我录制了一个宏并转到最后一个单元格，然后到第一个空单元格：

Range("A1048576").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
Application.CutCopyMode = False

我在 Excel 社区中找到的一种解决方案：

Sub compareresult()
    
    Dim row1 As Integer
    Dim row2 As Integer
    
    row2 = 1
    For row1 = 8 To 500
        If sheet1.Cells(row1, 11).value > sheet1.Cells(row1, 9).value Then
            sheet1.Cells(row1, 1).EntireRow.Copy Sheets(11).Cells(row2, 1)
            row2 = row2 + 1
        End If
    Next row1
    
End Sub

标签： excelvba

解决方案

如果 I1-I14 列中的单元格大于 J1-J14 列中的单元格，我想剪切整行并将值粘贴到第一个空行。（从第 16 行开始）

这是一种不会在循环中剪切和粘贴的方法。由于您没有删除行或“剪切和插入”行，因此这是一种简单的方法。以下代码遵循基本逻辑

逻辑

  1. 循环并确定范围。
  2. 如果找到，则复制 1 中的范围。
  3. 最后清除被复制的范围（如果被复制）。

代码

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim rngToCopy As Range
    Dim i As Long
    
    '~~> Change this to relevant sheet
    Set ws = Sheet1
    
    With ws
        '~~> Loop and identify the range
        For i = 2 To 14
            If .Range("I" & i).Value2 > .Range("J" & i).Value2 Then
                If rngToCopy Is Nothing Then
                    Set rngToCopy = .Rows(i)
                Else
                    Set rngToCopy = Union(rngToCopy, .Rows(i))
                End If
            End If
        Next i
        
        '~~> If found then copy and clear
        If Not rngToCopy Is Nothing Then
            rngToCopy.Copy .Rows(16)
            rngToCopy.Clear
        End If
    End With
End Sub

编辑：

合并新的编辑

完美运行！谢谢！:) 我没有完全描述我的问题。我还需要将它粘贴为特殊的（只粘贴值而不是公式）。你有什么快速的解决方案吗？– 乔尔 5 小时前

代替

rngToCopy.Copy .Rows(16)

到

rngToCopy.Copy
DoEvents
.Rows(16).PasteSpecial Paste:=xlPasteValues

推荐阅读