Excel & VBA: копирование строк в новый лист по значению ячейки

-3

Я новичок в Excel и VBA. У меня есть лист, как это:Excel & VBA: копирование строк в новый лист по значению ячейки

A  B  C   D 
someinfo someinfo someinfo OK 
someinfo someinfo someinfo OK 
someinfo someinfo someinfo ERROR 
someinfo someinfo someinfo ERROR 
someinfo someinfo someinfo OK 
someinfo someinfo someinfo OK 
someinfo someinfo someinfo ERROR 
someinfo someinfo someinfo ERROR

Ok я хотел бы, чтобы скопировать «OK» строки в новый лист и один с «ERROR» в другой.

Как я могу это сделать?

источник

2013-06-12 net.cat

Самый простой способ будет использовать фильтрацию и просто фильтр для 'OK', а затем копировать/вставить, затем фильтр для 'ERROR', затем скопируйте/вставьте. Если вы сделаете это во время записи макроса, вы будете на 90% от того, чтобы иметь решение VBA. –

На это ответили много раз, конечно, используйте поиск перед публикацией. Вы также можете проверить мои ответы, я ответил на аналогичный вопрос ранее сегодня. – user2140261

Извините, что я просматриваю stackoverflow, но я, вероятно, не нашел тему, на которую вы ссылаетесь. –

попробовать что-то вроде этого ...

Set sh = ThisWorkbook.Sheets("Sheet1") 
Set sh2 = ThisWorkbook.Sheets("Sheet2") 
Set sh3 = ThisWorkbook.Sheets("Sheet3") 
lastrow = sh.Cells(Rows.Count, "A").End(xlUp).row 
R = 2 
Do While R <= lastrow 
    If sh.Range("D" & R) = "OK" Then 
     sh.Range("A" & R & ":D" & R).Copy _ 
     Destination:=sh2.Range("A" & R) 
    Else 
     sh.Range("A" & R & ":D" & R).Copy _ 
     Destination:=sh3.Range("A" & R) 
    End IF 
Loop

Вы должны изменить строки/столбцы данных, поступающие из, чтобы удовлетворить ваши потребности, но я написал это на основе своего примера.

EDIT: С другой стороны, я немного читал об фильтрах, и я пошел бы с тем, что другие здесь разместили.

источник

2013-06-12 17:35:55

Это вызовет цикл Endless, в котором вы не увеличиваете 'R'. Поэтому 'R' ВСЕГДА будет меньше, чем' lastrow'. Я думаю, вам нужно использовать 'For R = 2 to lastrow' и заменить' Loop на Next R'. Кроме того, ваш MUC медленнее. Я запустил оба наших кода более 10 000 строк в 5 раз, каждый раз у меня было время аверса 0,615133072755998, в то время как у вас было среднее время 16,982829004747300. Thats ALMOST 28 раз медленнее, чем мое. – user2140261

Я забыл добавить R = R + 1. Но вы совершенно правы. Я тоже новичок в excel, но я работал над некоторым кодом, где я решил проблему таким образом. Фильтры - это путь, но я буду помнить об этом. –

Это нормально, я все еще учась каждый день. Я только ответил на этот вопрос, потому что сегодня я ответил на ВАШ вопрос с почти идентичным ответом, и, возможно, вы пропустили этот ответ, поэтому я повторил его здесь. – user2140261

Как уже говорилось в предыдущих комментариях это, как вы бы Filter ~> Copy ~> Вставить

Sub FilterAndCopy() 

Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.Calculation = xlCalculationManual 


Dim lngLastRow As Long 
Dim OKSheet As Worksheet, ErrorSheet As Worksheet 

Set OKSheet = Sheets("Sheet2") ' Set This to the Sheet name you want all Ok's going to 
Set ErrorSheet = Sheets("Sheet3") ' Set this to the Sheet name you want all Error's going to 

lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row 


With Range("A1", "D" & lngLastRow) 
    .AutoFilter 
    .AutoFilter Field:=4, Criteria1:="OK" 
    .Copy OKSheet.Range("A1") 
    .AutoFilter Field:=4, Criteria1:="ERROR" 
    .Copy ErrorSheet.Range("A1") 
    .AutoFilter 
End With 


Application.ScreenUpdating = True 
Application.EnableEvents = True 
Application.Calculation = xlCalculationAutomatic 

End Sub

источник

2013-06-12 17:44:00 user2140261

Запустив это, он копирует только первую строку, возможно, потому, что OK и Ошибка являются результатом функции, которая анализирует каждую строку –

@ user1800517 Это не имеет значения, пока ячейки сохраняют значение Ok или Error. Возможно, это потому, что я использовал столбец А в качестве ссылки для поиска последней строки ваших данных, если вы НЕ используете столбец A или есть вероятность того, что столбец A не имеет значений до конца, тогда вам, возможно, придется измените строку 'lngLastRow = Cells (Rows.Count,« A »). End (xlUp) .Row', вы должны изменить« A »на любой столбец, содержащий последнюю строку данных. Я сам тестировал этот код с вашими точными данными. Это сработало для меня. – user2140261

Excel & VBA: копирование строк в новый лист по значению ячейки

ответ

Смежные вопросы