Выборочное копирование и вставка строк с заданными критериями
Я пытаюсь выбрать строки в таблице на основе слова «Да», присутствующего в столбце J.
У меня есть таблица, идущая от столбца A к J, и я хочу выбрать строки, где в столбце J есть «Да», и вставить только эти строки в новый лист.
После выбора мне нужно скопировать эти строки на новый лист или текстовый документ.
Я пробовал ряд форумул, это для программного обеспечения Windows MS Excel с использованием макроса VBA.
Я использую следующий VBA, но возникают проблемы:
Sub Macro1()
Dim rngJ As Range
Dim cell As Range
Set rngJ = Range("J1", Range("J65536").End(xlUp))
Set wsNew = ThisWorkbook.Worksheets.Add
For Each cell In rngJ
If cell.Value = "Yes" Then
cell.EntireRow.Copy
wsNew.Sheets("Sheet1").Range("J65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next cell
End Sub
Любая помощь будет очень высоко ценится!
wsNew — рабочий лист. Вы, вероятно, получаете сообщение об ошибке, когда делаете wsNew.Sheets("Sheet1")...? I думать вы хотели бы просто сделать wsNew.Range("J66536").End(xlUp).Offset(1,0).Paste?
@BruceWayne - согласен, хотя я думаю, что вставка всей строки, начинающейся с J, также может вызвать ошибку?
Примечание. Не кодируйте последнюю ячейку жестко. В последних версиях Excel гораздо больше, чем 65536 строк, вместо них используется Range("J" & Rows.Count). • И вам может быть полезно прочитать Как избежать использования Select в Excel VBA.
Привет @jsheeran, спасибо, что так быстро ответили мне! Мое сообщение об ошибке: «Ошибка времени выполнения 438, объект не поддерживает это свойство или метод». Это происходит в строке wsNew.Sheets
@SJR - Хороший улов - OP может захотеть wsNew.Range("J66536").End(xlUp).Offset(1,0).EntireRow.Paste (я думаю, что это законная команда ... не могу точно вспомнить, куда EntireRow пойдет)
@BruceWayne спасибо за ваше предложение! Это останавливает появление ошибки, но просто создает новый пустой лист, ничего не вставляя.
Вы должны указать, на каком листе находятся данные RngJ. В настоящее время он будет использовать любой активный лист. Вы хотите сделать что-то вроде set rngJ = Worksheets("SheetName").Range(...). Также я предлагаю пройтись по вашему коду с помощью F8, так как он будет идти построчно, и вам будет легче следить за ним и видеть, где он идет не так.
@Pᴇʜ, спасибо :) Как мне не жестко кодировать последнюю ячейку? Могу ли я просто сделать Range("J1", Range("J").End.....?
Вы делаете это мог, но это будет довольно уродливый диапазон. Я склонен делать Dim lastRow as Long // lastRow = Range("J" & rows.count).End(xlUp).Row и использовать это, например. Range("J" & lastRow + 1).Value = "New Text"
@PKen, куда именно вы хотите его вставить?
@AAA либо на новый сгенерированный лист, либо на уже существующий лист, например. "ФиналСпец"
@BruceWayne спасибо :) Все еще борюсь с этим: wsNew.Range("J66536").End(xlUp).Offset(1,0).EntireRow.Paste Я получаю сообщение об ошибке "Объект не поддерживает этот метод" '.
Почему вы вставляете «J66536». Вы просто хотите вставить новый лист, верно?
@AAA да, я просто хочу вставить в новый лист, должен ли я сделать wsNew.Range("J").End(xlUp).Offset(1,0).EntireRow.Paste
Большое спасибо всем за вашу помощь. Я все еще изо всех сил пытаюсь вставить строки в новый лист, где столбец J на исходном листе имеет «Да» в ячейке.
Вам нужно использовать "J"?
Так что я мог бы просто иметь wsNew.Range.End(xlUp).Offset(1, 0).Paste ActiveSheet.Paste ?? @ААА
@PKen, проверьте мой ответ ниже, который работает, а также более эффективен.
Ответы 2
Используйте что-то вроде этого
Option Explicit
Public Sub CopyYesRowsToNewWorksheet()
Dim wsSource As Worksheet
Set wsSource = ThisWorkbook.ActiveSheet 'better define sheet by name ThisWorkbook.Worksheets("SourceSheet")
Dim DataRangeJ As Variant 'read "yes" data into array for faster access
DataRangeJ = wsSource.Range("J1", wsSource.Range("J" & wsSource.Rows.Count).End(xlUp)).Value
Dim wsNew As Worksheet
Set wsNew = ThisWorkbook.Worksheets.Add
Dim NextFreeRow As Long
NextFreeRow = 1 'start pasting in this row in the new sheet
If IsArray(DataRangeJ) Then
Dim iRow As Long
For iRow = LBound(DataRangeJ) To UBound(DataRangeJ) 'loop through data array
If DataRangeJ(iRow, 1) = "yes" Then
wsNew.Rows(NextFreeRow).Value = wsSource.Rows(iRow).Value 'copy the values of the row
NextFreeRow = NextFreeRow + 1
End If
Next iRow
ElseIf DataRangeJ = "yes" Then 'if only the first row has data
wsNew.Rows(NextFreeRow).Value = wsSource.Rows(1).Value
End If
End Sub
Линия
wsNew.Rows(NextFreeRow).Value = wsSource.Rows(iRow).Value
только копирует значение без форматирования. Если вы также хотите скопировать форматирование, замените его на
wsSource.Rows(iRow).Copy Destination:=wsNew.Rows(NextFreeRow)
Привет @PEH, большое спасибо за помощь и добрые объяснения! Я получаю ошибку несоответствия с этим в строке @ For iRow = LBound (DataRangeJ) To UBound (DataRangeJ) 'цикл через массив данных Любые идеи, почему это может быть?
нет или только одно «да» в столбце J. См. мой отредактированный ответ.
Привет @Pᴇʜ Спасибо за помощь. Этот код создает новый лист, но ничего не копируется. У меня есть таблица, идущая от столбца A к J, и я хочу выбрать строки, где в столбце J есть "Да", и вставить только эти строки в новый лист...
Вместо поиска, копирования и вставки для каждой ячейки, почему бы не найти все, а затем скопировать и вставить один раз следующим образом:
Sub Macro1()
Dim rngJ As Range
Dim MySel As Range
Set rngJ = Range("J1", Range("J" & Rows.Count).End(xlUp))
Set wsNew = ThisWorkbook.Worksheets.Add
For Each cell In rngJ
If cell.Value = "Yes" Then
If MySel Is Nothing Then
Set MySel = cell.EntireRow
Else
Set MySel = Union(MySel, cell.EntireRow)
End If
End If
Next cell
If Not MySel Is Nothing Then MySel.Copy Destination:= wsNew.Range("A1")
End Sub
Лучше избегать использования Select как можно чаще; см. этот связь.