Два макроса Excel, кажется, конфликтуют и мешают друг другу работать - PullRequest
0 голосов
/ 17 декабря 2018

Я пытался записать некоторые макросы в межведомственную электронную таблицу, которая, когда я нажимаю командную кнопку, по сути, «архивирует» ряд работ.У меня также есть один, который предназначен для автоматической заглавной буквы столбца, когда люди вводят его.См. Ниже:

Это макрос Archive:

Sub Archive()


If MsgBox("Do you want to archive the selected row?" & vbNewLine & vbNewLine & "Row should only be archived after x has passed.", vbYesNo, "Archive") = vbNo Then Exit Sub

For Each WSheet In ActiveWorkbook.Worksheets
        If WSheet.AutoFilterMode Then
            If WSheet.FilterMode Then
                WSheet.ShowAllData
            End If
        End If
        For Each DTable In WSheet.ListObjects
            If DTable.ShowAutoFilter Then
                DTable.Range.AutoFilter
                DTable.Range.AutoFilter
            End If
        Next DTable
    Next WSheet

'Declare variables
    Dim sht1 As Worksheet
    Dim sht2 As Worksheet
    Dim lastRow As Long

'Set variables
    Set sht1 = Sheets("xDepartment")
    Set sht2 = Sheets("Archive")

'Select Entire Row
    Selection.EntireRow.Select

'Move row to destination sheet & Delete source row
    lastRow = sht2.Range("A" & sht2.Rows.Count).End(xlUp).Row

    With Selection
        .Copy Destination:=sht2.Range("A" & lastRow + 1)
        .EntireRow.Delete
    End With

End Sub

Макрос автокапитализации прикреплен к конкретному листу?(т. е. он присоединяется при щелчке правой кнопкой мыши по «xDepartment» и выборе «Просмотр кода» - не уверен, имеет ли это какое-либо отношение к нему?).На этом листе также есть макрос, который вычисляет дату изменения данных в определенной ячейке:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A1 As Range
    Set A1 = Range("O:O,Q:Q,T:T,W:W")
    If Not Intersect(Target, A1) Is Nothing Then
        Application.EnableEvents = False
            Target.Value = UCase(Target.Value)
        Application.EnableEvents = True
    End If

    Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("O:O, Q:Q"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd/mm/yyyy"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If

End Sub

Появляется ошибка «Ошибка времени выполнения 13»: несоответствие типов ».Вы знаете, почему это может происходить?

Заранее спасибо!

Ответы [ 2 ]

0 голосов
/ 17 декабря 2018

Ваш код для перемещения строки с рабочего листа xDepartment на рабочий лист архива содержит строку,

Selection.EntireRow.Select

Это делает рабочий лист xDepartment активным.Код для фактического перемещения строки и удаления оригинала ничего не делает для изменения xDepartment в качестве ActiveSheet.

With Selection
    .Copy Destination:=sht2.Range("A" & lastRow + 1)
    .EntireRow.Delete
End With

В вашем рабочем листе_change у вас есть

Set WorkRng = Intersect(Application.ActiveSheet.Range("O:O, Q:Q"), Target)

Итак, ваш рабочий лист архиваWorksheet_Change попытается поработать с рабочим листом xDepartment.

Но вы удалили строку, чтобы она больше не существовала;hen ce:

Ошибка времени выполнения '13': несоответствие типов

Установите WorkRng с помощью,

    Set WorkRng = Intersect(Range("O:O, Q:Q"), Target)

Это в частномподпроцедура в личном кодовом листе архива, поэтому нет необходимости указывать родительский рабочий лист, если вы не хотите специально работать с другим рабочим листом.

Избегайте использования ActiveSheet, Select, Selection и Activate, когда это возможно, и никогда не используйте их в закрытом кодовом листе рабочего листа для ссылки на этот рабочий лист.

0 голосов
/ 17 декабря 2018

После вашей первой строки в макросе Archive поместите

Application.EnableEvents = False
On error goto Whoops

Затем чуть выше вашего End Sub для этого макроса, поместите

 Whoops:
 Application.EnableEvents = True

Это отключит другой макрос, пока ваш архивработает

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