根据条件将行复制到两个不同的电子表格中

Question

我有一列填充了一系列六位数字的列“B”。我正在寻找我的代码来查找最后一位数字，并根据结果（0到4或5到9）将其复制到单独的电子表格中。在我的代码拿起在B列中各行的最后一位，但随后并没有将其粘贴到右侧纸：

For r = 1 To endRow 

ThisValue = Range("B" & r).Value 
LResult = Right(ThisValue, 1) 


If LResult = 0 Or 1 Or 2 Or 3 Or 4 Then 

     Rows(r).Select 
     Selection.Copy 

     Sheets("Sheet2").Select 
     Rows(pasteRowIndex).Select 
     ActiveSheet.Paste 

     pasteRowIndex = pasteRowIndex + 1 

     Sheets("Sheet1").Select 

     Else 

     Rows(r).Select 
     Selection.Copy 

     Sheets("Sheet3").Select 
     Rows(pasteRowIndex).Select 
     ActiveSheet.Paste 

     pasteRowIndex = pasteRowIndex + 1 

     Sheets("Sheet1").Select 

    End If 
Next r 

Answer 1

我相信所有的条件需要进行阐明，所以不是Or 1它应该是Or LResult = 1。但你可能会使用一个Select Case会更好：

Select Case LResult 
    Case 0 To 4 
     ' ... Code 
    Case Else 
     ' ... Code 
End Select 

Answer 2

当使用多个工作表，这是非常重要，以确保您的Excel告诉用什么床单和也avoid using .Select只要有可能。

请参阅下面的代码。我为工作表添加了一些变量。我还不能肯定这片你ThisValue所以你可能需要ws1根据需要编辑：

Sub test() 
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet 

Set ws1 = Sheets("Sheet1") 
Set ws2 = Sheets("Sheet2") 
Set ws3 = Sheets("Sheet3") 
endrow = ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row 
pasteRowIndex = 1 
For r = 1 To endrow 

    ThisValue = ws1.Range("B" & r).Value 
    LResult = Right(ThisValue, 1) 

    If LResult = 0 Or LResult = 1 Or LResult = 2 Or LResult = 3 Or LResult = 4 Then 
     ws2.Rows(pasteRowIndex).Value = ws1.Rows(r).Value 
     pasteRowIndex = pasteRowIndex + 1 
    Else 
     ws3.Rows(pasteRowIndex).Value = ws1.Rows(r).Value 
     pasteRowIndex = pasteRowIndex + 1 
    End If 
Next r 

End Sub 

此外，尝试看我怎么删除您.Select，只是与细胞直接合作。

编辑：你在哪里定义什么pasteRowIndex是？它不在你提供的代码中，我假设你在别处有它......但你需要它。那是什么？为了测试目的，我为第一次迭代设置为1。之后，它只是增加了一个这个数字。

此外，我删除了复制/粘贴，它可以变得棘手/恼人的多张（在我看来），所以相反，我只是设置两行的值等于彼此。你能看到我是怎么做到的吗？

最后，当使用and或or来检查变量的值时，您必须每次重复逻辑。看看我是如何改变你的生产线以包括每个数值的LResult =？另一种方式，你可以做到这一点是If LResult <= 4 Then ...