Этот код, который у меня есть, кажется, копирует, вставляет и удаляет все остальные строки. Я потерял какие-либо идеи кого-нибудь?

Dim c As Long, rG As Range, vR As Variant
c = 1000
Dim wsA As Worksheet, wsC As Worksheet
Set wsA = Sheets("Active")
Set wsC = Sheets("Closed")
wsA.Activate
For Each rG In Intersect(Range("Y:Y"), ActiveSheet.UsedRange)
    vR = rG.Value
    If InStr(vR, "Yes") > 0 Then
        rG.EntireRow.Copy wsC.Cells(c, 1)
        rG.EntireRow.Delete
        c = c + 1
    End If
Next rG

Кроме того, единственная причина, по которой у меня есть C = 1000, заключается в том, что я не знаю, как заставить его вставлять в столбец A («Закрытый») столбец в конце, где находится первая пустая ячейка. Я бы предпочел, потому что, как только у нас появятся другие 1000 ячеек, мой код начнется с замены в ячейках A1000.

Спасибо за любую помощь, ребята

1
Joshua Martinez 24 Фев 2018 в 01:24

3 ответа

Лучший ответ

Что-то типа:

For i = ActiveSheet.Range("Y" & Rows.Count).End(xlUp).Row to 1 step -1
    set rG = Range("Y" & i)
    vR = rG.Value
    If InStr(vR, "Yes") > 0 Then
        rG.EntireRow.Copy wsC.Cells(c, 1)
        rG.EntireRow.Delete
        c = c + 1
    End If
Next i

Вы также можете исправить значение c с помощью Rows.Count

3
cybernetic.nomad 8 Ноя 2018 в 00:02
Dim c As Long, rG As Range, vR As Variant
c = 1000
Dim wsA As Worksheet, wsC As Worksheet
Set wsA = Sheets("Active")
Set wsC = Sheets("Closed")
wsA.Activate
For i = ActiveSheet.Range("X" & Rows.Count).End(xlUp).Row To 1 Step -1
Set rG = Range("X" & i)
vR = rG.Value
If InStr(vR, "/") > 0 Then
    rG.EntireRow.Copy wsC.Cells(c, 1)
    rG.EntireRow.Delete
    c = c + 1
End If
Next I

Это то, что у меня сейчас, и это прекрасно работает, однако, как вы можете видеть, у меня все еще есть c = 1000 каждый раз, когда я пытаюсь редактировать c, я получаю сообщение об ошибке, поэтому я не знаю, как это сделать. Спасибо за все, что вы, ребята, молодцы!

1
Joshua Martinez 23 Фев 2018 в 23:04

Вам не обязательно делать шаг назад, если вы добавляете строки для удаления в специальный диапазон. Когда вы закончите цикл, просто удалите весь специальный диапазон, который мы назовем delRng.

Dim c As Long, rG As Range, vR As Variant, delRng As Range '<-- New Variable Declaration
c = 1000
Dim wsA As Worksheet, wsC As Worksheet
Set wsA = Sheets("Active")
Set wsC = Sheets("Closed")
wsA.Activate
For Each rG In Intersect(Range("Y:Y"), ActiveSheet.UsedRange)
    vR = rG.Value
    If InStr(vR, "Yes") > 0 Then
        If delRng Is Nothing Then  '<-- Don't use union() if delRng Is Nothing
            Set delRng = rG.EntireRow
        Else
            Set delRng = Union(delRng, rG.EntireRow)
        End If
        rG.EntireRow.Copy wsC.Cells(c, 1)
        c = c + 1
    End If
Next rG

' Delete your delRng - after you finish looping
If Not delRng Is Nothing Then delRng.Delete

Вы можете даже заметить увеличение производительности, не удаляя эти диапазоны по одному, но все сразу.

Для получения дополнительной информации об использовании метода Union(), смотрите здесь.

1
K.Dᴀᴠɪs 23 Фев 2018 в 22:54