Question

附带的代码从下拉列表中获取用户输入，在另一张工作表中找到匹配的标题，并将一列数据从一张工作表（“分类值”）复制到另一张工作表（“ 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

Answer 1

@ K.Davis指出，您的import csv # pull your arrays together for convenience myarrs = (freeNames, fullPhones, fullStreets, fullWebsites) # figure out which is the longest nrows = max(len(a) for a in myarrs) # pad everything to be the same length padded = tuple(a + ['']*(nrows-len(a)) for a in myarrs) # write it all out csv.writer(trustedprotxtfile).writerows(zip(*padded))可能有问题。只需关闭Events一次，并确保所有可能带来更改的代码都嵌套在Events陷阱中。

使用Event和Select Case块可以大大减少您的代码。这样还可以显着提高可读性，这将有助于您调试代码。

With

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代码出现间歇性的“内存不足”错误

2 个答案: