Копирование строк в две разные таблицы в зависимости от критериев

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 ...