VBA 将列从一个 sheet 复制到另一个的代码出现间歇性 "out of memory" 错误

Question

附加代码从 drop-down 列表中获取用户输入，在另一个 sheet 中找到匹配的 header，并从 sheet 中复制一列数据（ "Classification Values") 到另一个 ("CLASS_CHECK").

但是，此代码在多次使用后会导致 "out of memory" 错误。

有什么想法可以改进我的代码以使其不会运行内存不足吗？

谢谢！

代码：

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

Answer 1

@K.Davis 指出，您的 Events 可能有问题。只需关闭 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

Answer 2

建议将此作为一种可能的重构以删除全局变量和重复项：

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

VBA 将列从一个 sheet 复制到另一个的代码出现间歇性 "out of memory" 错误

VBA code that copies column from one sheet to another has intermittent "out of memory" error

excel

vba

out-of-memory