Экземпляры Excel. Скопируйте и вставьте отфильтрованные строки.

Question

Итак, исходя из выпадающего списка на листе "B", мы хотим прокрутить кучу строк на листе "A", удалить все из них, у которых нет Cell(4) = dropDownValue, а затем скопировать этот диапазон и вставьте его в лист "B". Код ниже работает, но ничего не делает.

Я могу отлаживать и видеть, что dropDownValue сохранен правильно, а также что Cell(4), кажется, правильно вытягивается для каждой строки, через которую он проходит. Совершенно новый для VBA здесь, исходя из фона C#, поэтому это кажется мне очень запутанным.

Любые идеи о том, как исправить это или что я делаю неправильно?

Sheets("B").Select 
Dim dropDownValue As String 
dropDownValue = Left(Range("L1").Value, 3) 

Dim wantedRange As Range 
Dim newRange As Range 
Dim cell As Object 
Dim i As Integer 
Set wantedRange = Sheets("A").Range("E11:E200") 
For i = 1 To wantedRange.Rows.Count Step 1 
    Dim target As String 
    target = wantedRange.Rows(i).Cells(4) 
    If Not (target Like dropDownValue) Then 
     wantedRange.Rows(i).Delete 
    End If 
Next i 

Sheets("B").Select 
Application.CutCopyMode = False 
wantedRange.copy 
Selection.wantedRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 

Answer 1

Мой ответ основан на том, что я понял из этой линии, вы упомянули в вашей должности

удалить все из них, которые не имеют ячейки (4) = dropDownValue

Мой первый вопрос будет.

Какие данные у вас есть в Col E? Номера или текст?

Если это текст, вы можете использовать этот код, который очень быстр. Он использует «Автофильтр», а не зацикливание ячеек.

Option Explicit 

Sub Sample() 
    Dim ws1 As Worksheet, ws2 As Worksheet 
    Dim LookupVal As String 
    Dim ws1rng As Range, toCopyRange As Range 

    On Error GoTo Whoa 

    Application.ScreenUpdating = False 

    Set ws1 = Sheets("A") 
    Set ws2 = Sheets("B") 

    LookupVal = "<>*" & Left(ws2.Range("L1").Value, 3) & "*" 

    Set ws1rng = ws1.Range("E11:E200") 

    ws1.AutoFilterMode = False 

    With ws1rng 
     .AutoFilter Field:=1, Criteria1:=LookupVal, Operator:=xlAnd 
     Set toCopyRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible) 
    End With 

    ws1.AutoFilterMode = False 

    '~~> Will copy the data to Sheet B cell A20 
    toCopyRange.Copy ws2.Range("A20") 

LetsContinue: 
    Application.ScreenUpdating = True 
    Exit Sub 
Whoa: 
    MsgBox Err.Description 
    Resume LetsContinue 
End Sub 

И если это число, то использовать этот

Option Explicit 

Sub Sample() 
    Dim sDropDown As String 
    Dim lRowCnt As Long, i As Long 
    Dim delRange As Range 

    On Error GoTo Whoa 

    Application.ScreenUpdating = False 

    sDropDown = Left(Sheets("B").Range("L1").Value, 3) 

    With Sheets("A").Range("E11:E200") '<~~ Modified Reafidy's code :) 
     For lRowCnt = .Rows.Count To 1 Step -1 
      If (.Rows(lRowCnt).Value Like "*" & sDropDown & "*") Then 
       If delRange Is Nothing Then 
        Set delRange = .Rows(lRowCnt) 
       Else 
        Set delRange = Union(delRange, .Rows(lRowCnt)) 
       End If 
      End If 
     Next lRowCnt 

     If Not delRange Is Nothing Then 
      delRange.Delete 
     End If 

     lRowCnt = Sheets("A").Range("E" & Rows.Count).End(xlUp).Row 

     '~~> Will copy the data to Sheet B cell A20 
     Sheets("A").Range("E11:E" & lRowCnt).Copy Sheets("B").Range("A20") 
    End With 

LetsContinue: 
    Application.ScreenUpdating = True 
    Exit Sub 
Whoa: 
    MsgBox Err.Description 
    Resume LetsContinue 
End Sub 

Answer 2

При удалении таких строк вам нужно работать в обратном направлении. Попробуйте:

For i = wantedRange.Rows.Count To 1 Step -1 

ЗАМЕЧАНИЕ: В VBA все размеров должны быть в верхней части модуля.

ПРИМЕЧАНИЕ B: Циклирование в порядке, но если вы хотите повысить эффективность или у вас есть много строк для поиска, а вместо цикла используйте автофильтр с формулой, а затем удалите видимые строки.

Примечание C: При работе со строками использовать длинные вместо целого числа, чтобы предотвратить переполнение так в вашем случае:

Dim i As Long 

ПРИМЕЧАНИЕ D: Как уже упоминалось выше, Тим.

Вот некоторые изменения, которые могут помочь:

Dim sDropDown As String 
Dim lRowCnt As Long 

sDropDown = Left(Sheets("B").Range("L1").Value, 3) 

With Sheets("A").Range("E11:E200") 
    For lRowCnt = .Rows.Count To 1 Step -1 
     If Not (.Rows(lRowCnt).Value Like "*" & sDropDown "*") Then 
      .Rows(lRowCnt).Delete 
     End If 
    Next i 

    Sheets("B").Resize(.Rows.Count, .Columns.Count).Value = .Value 
End With 

Пример метода автофильтрации:

Dim sFilter As String 

sFilter = "<>*" & Left(Sheets("B").Range("L1").Value, 3) & "*" 

Application.ScreenUpdating = False 

With Sheets("A").Range("E11:E200") 
    .Offset(-1, 0).Resize(.Rows.Count + 1).AutoFilter Field:=1, Criteria1:=sFilter, Operator:=xlAnd 
    .EntireRow.Delete 
    .Parent.AutoFilterMode = False 
    Sheets("B").Cells(1, 1).Resize(.Rows.Count, 1).Value = .Value '// Output 
End With 

Application.ScreenUpdating = True