1

Моя компания использует Excel для отслеживания проверок и технического обслуживания переносных огнетушителей, и я пытаюсь добавить к ним некоторые функции, но не имею ни малейшего представления о том, как это сделать. Я сделаю все возможное, чтобы объяснить, с чем мне нужна помощь:

Все три листа будут иметь одинаковые заголовки столбцов в строке 1. На первом и втором листах в рабочей книге (соответственно, "Ежемесячно" и "Ежегодно") я использую условное форматирование для окрашивания ячеек в столбцах Y и AC на основе значений, определенных по формуле (Желтый, если вычисление возвращает значение меньше 90, красный, если возвращаемое значение равно 0 или отрицательному числу).

Макрос, который я хотел бы сделать, это скопировать всю строку из столбца A в столбец AD на третий лист (под названием "Maint Due"). Также было бы неплохо, если бы этот процесс был автоматизирован таким образом, чтобы в любое время значения в столбцах Y и AC изменялись на листах "Ежемесячно" или "Ежегодно", информация на листе "Основное время" автоматически обновлялась (но если мне нужно Перезапустите макрос вручную, чтобы это произошло.

Надеюсь, я объяснил, что я пытаюсь сделать так, чтобы это имело смысл для кого-то, и они могут предложить помощь. У меня очень мало опыта в программировании, и прошло 15 лет с тех пор, как я действительно занимался программированием, поэтому я очень ржавый. Я ценю любые советы или помощь, которые могут дать люди!

РЕДАКТИРОВАТЬ:

Я никогда не использовал Макро-рекордер, и я могу только понять, как создать макрос для копирования и вставки, поэтому мне не повезло. Пройдя еще несколько поисков и просмотрев несколько видео, я соединил это:

Sub Show_on_Maint()
x = 2
'Sets the starting row
Do While Cells(x, 2) <> ""
    'Continue to evaluate until a blank cell is reached
    If Cells(x, 25) <= 90 Then
        'Evaluates the cell in column Y to determine if the value is less than or equal to 90
        Sheets("Sheet1").Rows(x).Copy Sheets("Sheet6").Range("A2")
        'Copies the row to the Maint Due sheet
    Else
        If Cells(x, 29) <= 90 Then
            'Evaluates the cell in column AC to determine if the value is less than or equal to 90
            Sheets("Sheet1").Rows(x).Copy Sheets("Sheet6").Range("A2")
            'Copies the row to the Maint Due sheet
        End If
    End If
    x = x + 1
Loop
End Sub

Когда я запускаю / отлаживаю его, я получаю цикл без ошибки Do. Я думаю, что моя логика правильна, но у меня недостаточно опыта, чтобы понять, почему я получаю эту ошибку.

РЕДАКТИРОВАТЬ: отсутствует конец, если раньше х = х + 1

Теперь я получаю сообщение об ошибке выполнения 9 "Subscript out of range" по адресу:Sheets("Sheet1").Rows(x).Copy Sheets("Sheet6").Range("A2")

Скриншот
(Нажмите на изображение, чтобы увеличить)

1 ответ1

0

Вы упомянули, что хотели бы, чтобы это автоматически копировало информацию в Maint Due, поэтому я буду работать с этим. Макрос события изменения Worksheet может охватывать автоматизацию , но вы должны были бы по одному для каждого из ежемесячных и годовых рабочих листов. Я предложу Workbook_SheetChange который анализирует исходный лист в поиске на Ежемесячный или Ежегодный.

Нажмите Alt+F11 и, когда откроется VBE, посмотрите на проводник проектов с левой стороны для ThisWorkbook. Если у вас нет открытого Project Explorer, нажмите Ctrl+R, чтобы показать его. Щелкните правой кнопкой мыши ThisWorkbook и выберите View Code . В новой области справа под названием что-то вроде Book1 - ThisWorkbook (Код) вставьте следующее.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If LCase(Sh.Name) = "monthly" Or LCase(Sh.Name) = "annual" Then
        If Not Intersect(Target, Sh.Range("Y:Y, AC:AC")) Is Nothing Then
            On Error GoTo Fìn
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            Dim lc As Long, r As Range
            For Each r In Intersect(Target, Sh.Range("Y:Y, AC:AC"))
                If r.Value <= 90 Then
                    lc = Sh.Cells(1, Columns.Count).End(xlToLeft).Column
                    Sh.Cells(r.Row, 1).Resize(1, lc).Copy _
                      Destination:=Sheets("Maint Due").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                End If
            Next r
        End If
    End If
Fìn:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Нажмите Alt+Q, чтобы вернуться к своей книге. Любые новые значения, введенные в столбец Y годового или ежемесячного рабочего листа Y или столбец AC, будут приводить к тому, что эта строка будет скопирована в следующую пустую строку рабочего листа Maint Due.

Первая проблема, которую я вижу, заключается в том, что макросы инициируемых событий не срабатывают при изменении результата формулы. Были некоторые упоминания о том, что столбцы Y и AC рассчитываются, поэтому триггер может быть для столбца, создающего значение (я) в столбцах Y и AC, а не сами столбцы Y и Ac. Столбцы V и X выглядят вероятными кандидатами.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .