Определяя последнюю ячейку в определенном диапазоне и заполняя ее, VBA - PullRequest
0 голосов
/ 30 января 2019

Поэтому мне нужно определить первую пустую ячейку в каждом из диапазонов «Уровень редакции» («C82: F91»), «Дата редакции» («G82: G91») и «Комментарии или примечания для редакции».(«H82: R91») и заполните его правильной информацией.Для "revlvl" мне нужно просто добавить одно к предыдущему значению, другую информацию, которую я знаю, как рассчитать.

Итак, что нужно сделать, это на строке ниже уровня 000 оборотов, он поместит 001 на уровне ревизии, сегодняшнюю дату в дате ревизии и ввод текста в поле ввода в комментарии и заметки.Затем, если цикл запустится снова, он поместит 003, дату и примечания в 3-й строке вниз.

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

This is the sheet im working with and the ranges

enter image description here

If Sheets("Monthly Status").Range("G82") = "" Then
'do nothing
Else

    Dim i As Integer
    Dim Revnotes As Range
    Dim RevDate As Range
    Dim revlvl As Range

    Set Revnotes = Sheets("Monthly Status").Range("H83:R83")
    Set RevDate = Sheets("Monthly Status").Range("G83")
    Set revlvl = Sheets("Monthly Status").Range("C83:F91")

    For i = 0 To 49

    cRow = i + 23

        For j = 0 To 2

                If Sheets("Monthly Status").Cells(cRow, j + 11) <> Sheets("Monthly Status").Cells(cRow, j + 37) Then
                    RevDate = Date
                    Revnotes = InputBox("You Changed dates, you must imput notes for this revison!", "Notes")
                    revlvl = Sheets("Monthly Status").Range("C83") + 1

                        Application.ScreenUpdating = False

                        Sheets("Monthly Status").Range("K23:M72").Copy
                        Sheets("Monthly Status").Range("AK23:AM72").PasteSpecial xlPasteValues

                        Application.ScreenUpdating = True

                    End
                End If
            Next j
        Next i

    End If

1 Ответ

0 голосов
/ 30 января 2019

Чтобы найти следующую свободную строку в диапазоне C82:F91, используйте что-то вроде следующего, чтобы вам не пришлось зацикливаться.

Dim rng As Range
Set rng = Worksheets("Monthly Status").Range("C82:F91")

Dim NextFreeRow As Long
With rng.Cells(rng.Rows.Count, 1)
    If .Value = vbNullString Then 'test if range is full
        NextFreeRow = .End(xlUp).Row + 1 'find next free row
    Else
        MsgBox "range is full"
        Exit Sub
    End If
End With

'add +1 to the previous value
Worksheets("Monthly Status").Cells(NextFreeRow, "C").Value = Worksheets("Monthly Status").Cells(NextFreeRow - 1, "C").Value + 1

Этот пример должен помочь вам решить вашу проблему.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...