В коде VBA, копирующем столбец с одного листа на другой, периодически возникает ошибка «недостаточно памяти» - PullRequest
Новая
       7

В коде VBA, копирующем столбец с одного листа на другой, периодически возникает ошибка «недостаточно памяти»

0 голосов
/ 08 ноября 2018

Прикрепленный код берет пользовательский ввод из раскрывающегося списка, находит соответствующий заголовок на другом листе и копирует столбец данных с одного листа («Значения классификации») на другой («CLASS_CHECK»).

Этот код вызывает ошибки «нехватки памяти» после стольких случаев использования.

Есть идеи, как мне улучшить свой код, чтобы он не исчерпал память?

Спасибо!

Код: 

Public headerTitle As String

Private Sub Worksheet_Change(ByVal Target As Range)

    headerTitle = Range("title").Value
    Debug.Print (headerTitle)
    Call doStuffWithTable
End Sub

Public Sub doStuffWithTable()

    If (headerTitle = "Analog") Then
        Application.EnableEvents = False
        Sheets("CLASS_CHECK").Range("Column").Value = Sheets("Classification Values").Range("Analog").Value
        Application.EnableEvents = True
    ElseIf (headerTitle = "Asic") Then
        Application.EnableEvents = False
        Sheets("CLASS_CHECK").Range("Column").Value = Sheets("Classification Values").Range("Asic").Value
        Application.EnableEvents = True
    ElseIf (headerTitle = "Board Artifacts") Then
        Application.EnableEvents = False
        Sheets("CLASS_CHECK").Range("Column").Value = Sheets("Classification Values").Range("Board").Value
        Application.EnableEvents = True
    ElseIf (headerTitle = "Clock") Then
        Application.EnableEvents = False
        Sheets("CLASS_CHECK").Range("Column").Value = Sheets("Classification Values").Range("Clock").Value
        Application.EnableEvents = True
    ElseIf (headerTitle = "Connector") Then
        Application.EnableEvents = False
        Sheets("CLASS_CHECK").Range("Column").Value = Sheets("Classification Values").Range("Connector").Value
        Application.EnableEvents = True
    ElseIf (headerTitle = "Digital") Then
        Application.EnableEvents = False
        Sheets("CLASS_CHECK").Range("Column").Value = Sheets("Classification Values").Range("Digital").Value
        Application.EnableEvents = True
    ElseIf (headerTitle = "Discrete: Capacitor") Then
        Application.EnableEvents = False
        Sheets("CLASS_CHECK").Range("Column").Value = Sheets("Classification Values").Range("Capacitor").Value
        Application.EnableEvents = True
End Sub

Ответы [ 2 ]

0 голосов
/ 08 ноября 2018

Предложил бы это как один из возможных рефакторинг для удаления глобальной переменной и повторения: 

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngTitle As Range
    Set rngTitle = Me.Range("title")
    If Not Application.Intersect(Target, rngTitle) Is Nothing Then
        doStuffWithTable rngTitle.Value
    End If
End Sub

Public Sub doStuffWithTable(title)
    Dim rngName As String

    Select Case title
        Case "Analog", "Asic", "Clock", "Connector", "Digital"
            rngName = title
        Case "Board Artifacts"
            rngName = "Board"
        Case "Discrete: Capacitor"
            rngName = "Capacitor"
    End Select

    If Len(rngName) > 0 Then
        Application.EnableEvents = False
        ThisWorkbook.Sheets("CLASS_CHECK").Range("Column").Value = _
            ThisWorkbook.Sheets("Classification Values").Range(rngName).Value
        Application.EnableEvents = True
    End If

End Sub
0 голосов
/ 08 ноября 2018

У вас могут быть проблемы с вашим Events, как указано @K.Davis. Просто отключите Events один раз и убедитесь, что весь код, который потенциально может внести изменения, вложен в ловушку Event.

Ваш код может быть значительно уменьшен при использовании блоков Select Case и With. Это также значительно улучшает удобочитаемость, что поможет вам в отладке кода. 

Sub TableStuff()

Dim CV As Worksheet
Set CV = Sheets("Classification Values")

Application.EnableEvents = False
    With Sheets("CLASS_CHECK").Range("Column")
        Select Case headerTitle
            Case "Analog"
               .Value = CV.Range("Analog").Value
            Case "Asic"
                .Value = CV.Range("Asic").Value
            Case "Board Artifacts"
                .Value = CV.Range("Board").Value
            Case "Clock"
                .Value = CV.Range("Clock").Value
            Case "Connector"
                .Value = CV.Range("Connector").Value
            Case "Digital"
                .Value = CV.Range("Digital").Value
            Case "Discrete: Capacitor"
                .Value = CV.Range("Capacitor").Value
        End Select
    End With
Application.EnableEvents = True

End Sub
...