使用excel vba将行移动到基于数值的不同工作表

我有一个工作表充满了库存数据。 在使用这些数据创build报告之前，我想检查一下完整性。 大多数情况下，我想检查是否有零填充零或者如果一个值可能比另一个更大（这不应该是可能的）。 所有符合这些标准的值（或者说整个列）都应该被移动到另一个工作表以供进一步检查。 我的代码到目前为止是这样的：

Sub CheckData() Dim SourceSheet As Worksheet Dim TargetSheet As Worksheet Dim i As Long Dim LR As Long Last_Column = Worksheets("data").Cells(1, Columns.Count).End(xlToLeft).Column For y = 1 To Last_Column HeadLine = Worksheets("data").Cells(1, y) If HeadLine = "Headline1" Then Col_H1 = y End If If HeadLine = "Headline2" Then Col_H2 = y End If Next y Set SourceSheet = Sheets("data") Set TargetSheet = Sheets("error") With SourceSheet LR = .Range("A" & .Rows.Count).End(xlUp).Row For i = 2 To LR If Sheets("data").Cells(i, Col_H1).Value = 0 Then x = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 SourceSheet.Rows(i).Copy TargetSheet.Rows(x) 'SourceSheet.Rows(i).Delete End If Next i End With End Sub 

现在理论上应该检查标题为“Headline1”的列中是否有值为0的单元格。 但是，虽然它复制了一些正确的值（值为零），但它也至less复制了我的语句不适用的那么多行。 同样的事情发生，如果我检查一个值是否比另一个大。 出于testing目的，复制的行还没有被删除，这就是为什么该行被注释掉。

Answer 1

你应该修改你的代码片段的一部分来正常工作，如下所示：

 'clear the target worksheet TargetSheet.Cells.Clear With SourceSheet LR = .Range("A" & .Rows.Count).End(xlUp).Row 'loop in reverse order because of Delete operation moves up the rest For i = LR To 2 Step -1 If .Cells(i, Col_H1).Value = 0 Then x = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Rows(i).Copy TargetSheet.Rows(x) .Rows(i).Delete End If Next i End With 

希望这可能有帮助。

Answer 2

希望这个答案可以帮助你：

 Sub CheckData() Dim SourceSheet As Worksheet Dim TargetSheet As Worksheet Dim i As Long Dim LR As Long Dim Last_Column Dim HeadLine Dim y Dim Col_H1 Dim Col_H2 Dim x 'Well as a good practice, (I) always declare any variable Set SourceSheet = Sheets("data") 'set the Worksheets vars Set TargetSheet = Sheets("error") SourceSheet.Activate 'go to data Last_Column = SourceSheet.Cells(1, Columns.Count).End(xlToLeft).Column For y = 1 To Last_Column HeadLine = SourceSheet.Cells(1, y) If HeadLine = "Headline1" Then 'Then loop over the cells inside the column With SourceSheet LR = .Range("A" & .Rows.Count).End(xlUp).Row For i = 2 To LR 'here we test if the value is 0 If .Cells(i, y).Value = 0 Then x = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Rows(i).Copy TargetSheet.Rows(x) 'SourceSheet.Rows(i).Delete End If Next i End With End If If HeadLine = "Headline2" Then With SourceSheet LR = .Range("A" & .Rows.Count).End(xlUp).Row For i = 2 To LR If .Cells(i, y).Value = 0 Then x = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 .Rows(i).Copy TargetSheet.Rows(x) 'SourceSheet.Rows(i).Delete End If Next i End With End If Next y End Sub 

注意：

不知道你为什么得到这个代码

  For i = 2 To LR If Sheets("data").Cells(i, Col_H1).Value = 0 Then i = i + 1 <===== WRONG x = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 SourceSheet.Rows(i).Copy TargetSheet.Rows(x) 'SourceSheet.Rows(i).Delete End If Next i 

由于该代码，您的代码将使用0值复制下一行，而不是所需的行。