Ниже приведена перезапись вашего кода с некоторыми незначительными изменениями. Я оставил несколько комментариев в коде, чтобы предоставить некоторую информацию о том, почему произошли изменения или что делает строка.
Чтобы кратко объяснить это; Я объявляю переменные для ваших значений для проверки, LastRow будет использоваться так же, как вы, но я предпочитаю это в переменной для удобства чтения. Оба листа одинаковы (но для моего тестирования я использовал Sheet2
и Sheet3
) и, наконец, массив для вашего диапазона для «копирования» и несколько переменных диапазона для циклов и место назначения для «вставки».
Ради тестирования я присвоил заданные значения Month
и Initials
.
Я включил некоторые с утверждениями, опять же, чтобы помочь читаемости.
Ваш For Each...Loop
был в порядке, как это было и дал ожидаемые результаты, когда я запустил его. Я подозреваю, что когда вы пытались это сделать, ваши значения могли не соответствовать вашим ожиданиям, так как я получал каждый MsgBox
, когда ожидал (я также добавил в сообщение немного дополнительной информации для отладки).
Вместо Copy
и Paste
, которые не являются наиболее эффективными функциями для использования, я все oop пробегаю по каждой строке в столбце B, ища месяц в формате цифр c - ( Январь = 1, февраль = 2 и т. Д. c.) - и, если найден, следующий условный оператор ищет строку «SE» в столбце A.
Если месяц верен, но строка не соответствует, MsgBox "Initials not found on row: " & Cell.Row
срабатывает, однако, если они совпадают, CopyRange
присваиваются значения из диапазона C6:E17
.
Затем создается Destination
, начиная с верхней левой ячейки диапазона и затем динамически изменен, чтобы соответствовать значениям массива. Затем массив записывается в диапазон Destination
.
Массив пересекает каждую строку, а затем переходит к следующей. Ниже приведен код примера скриншотов ввода и вывода.
Код
Sub CAJTest()
Dim Month As Long
Dim Initials As String
Dim LastRow As Long
Dim entryWS As Worksheet
Dim dataWS As Worksheet
Set entryWS = Sheet3 '<~~ assign your correct sheet here
Set dataWS = Sheet2 '<~~ assign your correct sheet here
Dim CopyRange As Variant 'To be used as an array for our values.
Dim Destination As Range
Dim Cell As Range
Dim Tasks As Range
Month = 6
Initials = "SE"
LastRow = dataWS.Range("B" & Rows.Count).End(xlUp).Row 'I prefer to assign the last row to a variable
With dataWS
For Each Cell In .Range("B2:B" & LastRow) 'I feel this is more readable than the above to find the last row being in this statement
If Cell.Value = Month Then
If Cell.Offset(0, -1).Value = Initials Then
MsgBox "found " & Month & " and " & Initials & " on row: " & Cell.Row
'the next line creates an array CopyRange with dimensions 1 to 12, 1 to 3 and assigns the values to the array
CopyRange = .Range(.Cells(Cell.Row, Cell.Offset(0, 1).Column), .Cells(Cell.Offset(11, 0).Row, Cell.Offset(0, 3).Column)) 'Can also be written as Range("C" & Cell.Row, "E" & Cell.Row + 11)
With entryWS
Set Destination = .Range("J15") 'Define top left cell of our destination
Set Destination = Destination.Resize(UBound(CopyRange, 1), UBound(CopyRange, 2)) 'Resize it per the bounds of our array
Destination.Value = CopyRange 'write the array to our newly resized destination range
End With
Exit For
Else
MsgBox "Initials not found on row: " & Cell.Row
End If
End If
Next
End With
End Sub
Снимки экрана
Значения в столбцах C, D и E представляют адрес ячейки.
Вывод, как и ожидалось, для адресата с измененным размером, начиная с J15
Для удаления строк:
Рассмотрим этот код для простого удаления данных из ячеек ...
If answer = vbYes Then
'Delete Cell.Row + the following 9 rows'
.Range(.Cells(Cell.Row, Cell.Column), .Cells(Cell.Offset(9, 0).Row, Cell.Column)).ClearContents
Exit For
Обратите внимание, что это не проверено, но правильный синтаксис. Этот оператор будет очищать только столбец, к которому относится ссылка Cell
, но диапазон начинается с ячейки и простирается на +9 строк.
Затем вы можете l oop пройти через лист и удалить строки на основе пустых ячеек. Это довольно медленный способ сделать это, но он полезен, если у вас непоследовательные пробелы.
Примечание: `ClearContents удалит значения из формул и из диапазона ,
Если вы также хотите удалить строки, чтобы избежать пропусков в ваших данных, вы можете определить свой диапазон и использовать метод EntireRow.Delete
...
If answer = vbYes Then
'Delete Cell.Row + the following 9 rows'
.Range(.Cells(Cell.Row, Cell.Column), .Cells(Cell.Offset(9, 0).Row, Cell.Column)).EntireRow.ClearContents
Exit For
Если у вас есть Возникли проблемы с этим методом, рассмотрите возможность добавления точки останова в этой строке ( F9 ) и затем запустите свой код. Когда в этой строке произойдет разрыв, проверьте правильность диапазона (введите ?.Range(.Cells(Cell.Row, Cell.Column), .Cells(Cell.Offset(9, 0).Row, Cell.Column)).Address
в окне и нажмите Enter).