Excel VBA：优化 Worksheet_Change 函数以避免“系统资源不足，无法完全显示”

【问题标题】：Excel VBA: Optimizing Worksheet_Change function to avoid "Not enough system resource to display completely"Excel VBA：优化 Worksheet_Change 函数以避免“系统资源不足，无法完全显示”
【发布时间】：2019-06-13 07:44:32
【问题描述】：

首先我需要说我是 VBA 的初学者。我了解 VBA 基础知识，并且我已经做过一些小项目，但其中大部分都涉及大量谷歌搜索。

对于当前的问题，我在网上找不到任何有用的提示。也许是因为我自己创建了代码。不过你自己看看吧……

我正在尝试使用客户数据创建一个表。该表包含手动添加的column "I" 中的客户编号。该表现在应该根据来自另一个选项卡中的静态数据库的客户编号自动获取其他客户数据，例如住所、年龄等。但是，我希望能够手动覆盖表中包含来自数据库的客户端数据的单元格。但是当我删除我的手动条目时，数据库中的原始数据应该会再次出现。

使用下面的代码，我能够做到这一点。当单元格为空时，代码会将formula 添加到从数据库中获取数据的单元格中。但是，我可以手动覆盖formula。当我删除我的手动输入并且单元格再次变为空时，formula 再次出现并从数据库中获取数据。但是我对下面的代码有两个问题：

  1. 代码似乎太“重”了。例如，当我删除行时，我收到一条错误消息 "Not enough system resource to display completely"，它会冻结整个 Excel 文件。

  2. 当我在column "I" 中添加新客户号码时，代码不会自动从数据库中提取数据。我需要为每个单元格触发Worksheet_Change，方法是选择单元格并单击Delete

所以我正在寻找一种方法来简化我的代码，以便：

  1. 删除行时不再出现错误信息；

  2. 当我在column "I" 中添加一个新客户号码时，同一行中的其他单元格应该会立即从数据库中获取其他客户数据。

我已经尝试了以下但没有成功：

    1234563已删除，但它不起作用，我仍然收到错误。

  1. 为了触发Worksheet_Change，我使用了以下代码Application.Run "Sheet3.Worksheet_Change", Range("A1:Z5000")，并将其分配给了一个按钮，但它不起作用。

所以这是现有的代码（注意代码看起来比它长。每一列的代码都是一样的，只是formulas不同，被放入单元格不同）：

Private Sub Worksheet_Change(ByVal Target As Range)

'Code for column B
Dim AffectedRange As Range
Set AffectedRange = Intersect(Target, Me.Range("B2:B" & Me.Rows.Count))

If Not AffectedRange Is Nothing Then
    Dim iCell As Range
    For Each iCell In AffectedRange.Cells

            If iCell.Value = vbNullString Then
            iCell.Formula = "=IFERROR(IF($I" & iCell.Row & "="""","""",VLOOKUP($I" & iCell.Row & ",'Raw Data'!$A$1:$AH$5000,4,FALSE)),""N/A"")"
        End If
    Next iCell
End If

'Code for column D
Dim AffectedRange1 As Range
Set AffectedRange1 = Intersect(Target, Me.Range("D2:D" & Me.Rows.Count))

If Not AffectedRange1 Is Nothing Then
    Dim iCell1 As Range
    For Each iCell1 In AffectedRange1.Cells

            If iCell1.Value = vbNullString Then
            iCell1.Formula = "=IFERROR(IF($I" & iCell1.Row & "="""","""",IF(VLOOKUP($I" & iCell1.Row & ",'Raw Data'!$A$1:$AH$5000,9,FALSE)=0,""N/A"",VLOOKUP($I" & iCell1.Row & ", 'Raw Data'!$A$1:$AH$5000,9,FALSE))),""N/A"")"
        End If
    Next iCell1
End If

'Code for column E
Dim AffectedRange2 As Range
Set AffectedRange2 = Intersect(Target, Me.Range("E2:E" & Me.Rows.Count))

If Not AffectedRange2 Is Nothing Then
    Dim iCell2 As Range
    For Each iCell2 In AffectedRange2.Cells

            If iCell2.Value = vbNullString Then
            iCell2.Formula = "=IFERROR(IF($I" & iCell2.Row & "="""","""",IF(VLOOKUP($I" & iCell2.Row & ",'Raw Data'!$A$1:$AH$5000,10,FALSE)=0,""N/A"",VLOOKUP($I" & iCell2.Row & ", 'Raw Data'!$A$1:$AH$5000,10,FALSE))),""N/A"")"
        End If
    Next iCell2
End If

'Code for column C
Dim AffectedRange4 As Range
Set AffectedRange4 = Intersect(Target, Me.Range("C2:C" & Me.Rows.Count))

If Not AffectedRange4 Is Nothing Then
    Dim iCell4 As Range
    For Each iCell4 In AffectedRange4.Cells

            If iCell4.Value = vbNullString Then
            iCell4.Formula = "=IFERROR(IF($I" & iCell4.Row & "="""","""",IF(VLOOKUP($I" & iCell4.Row & ",'Raw Data'!A$1:$AH$5000,22,FALSE)=0,""N/A"",IF(VLOOKUP($I" & iCell4.Row & ",'Raw Data'!A$1:$AH$5000,22,FALSE)<0.49999,""Prio 3"",IF(AND(VLOOKUP($I" & iCell4.Row & ",'Raw Data'!A$1:$AH$5000,22,FALSE)>0.49999,VLOOKUP($I" & iCell4.Row & ",'Raw Data'!A$1:$AH$5000,22,FALSE)<0.79999),""Prio 2"",IF(VLOOKUP($I" & iCell4.Row & ",'Raw Data'!A$1:$AH$5000,22,FALSE)>0.79999,""Prio 1"",""N/A""))))),""N/A"")"
        End If
    Next iCell4
End If

'Code for column H
Dim AffectedRange5 As Range
Set AffectedRange5 = Intersect(Target, Me.Range("H2:H" & Me.Rows.Count))

If Not AffectedRange5 Is Nothing Then
    Dim iCell5 As Range
    For Each iCell5 In AffectedRange5.Cells

            If iCell5.Value = vbNullString Then
            iCell5.Formula = "=IFERROR(IF($I" & iCell5.Row & "="""","""",IF(VLOOKUP($I" & iCell5.Row & ",'Raw Data'!$A$1:$AH$5000,11,FALSE)=0,""N/A"",VLOOKUP($I" & iCell5.Row & ", 'Raw Data'!$A$1:$AH$5000,11,FALSE))),""N/A"")"
        End If
    Next iCell5
End If

'Code for column F
Dim AffectedRange6 As Range
Set AffectedRange6 = Intersect(Target, Me.Range("F2:F" & Me.Rows.Count))

If Not AffectedRange6 Is Nothing Then
    Dim iCell6 As Range
    For Each iCell6 In AffectedRange6.Cells

            If iCell6.Value = vbNullString Then
            iCell6.Formula = "=IFERROR(IF($I" & iCell6.Row & "="""","""",(IF(OR($D" & iCell6.Row & "=""N/A"",$D" & iCell6.Row & "=""""),""N/A"",IF(AND($H" & iCell6.Row & "=""Espagne"",LEN($D" & iCell6.Row & ")=5),VLOOKUP(LEFT($D" & iCell6.Row & ",2),Regionslist!$A$1:$B$52,2,FALSE),IF(AND($H" & iCell6.Row & "=""Espagne"",LEN($D" & iCell6.Row & ")=4),VLOOKUP(""0""&LEFT($D" & iCell6.Row & ",1),Regionslist!$A$1:$B$52,2,FALSE),$H" & iCell6.Row & "))))),$H" & iCell6.Row & ")"
        End If
    Next iCell6
End If

'Code for column G
Dim AffectedRange7 As Range
Set AffectedRange7 = Intersect(Target, Me.Range("G2:G" & Me.Rows.Count))

If Not AffectedRange7 Is Nothing Then
    Dim iCell7 As Range
    For Each iCell7 In AffectedRange7.Cells

            If iCell7.Value = vbNullString Then
            iCell7.Formula = "=IFERROR(IF($I" & iCell7.Row & "="""","""",VLOOKUP($F" & iCell7.Row & ",Regionslist!$B$1:$C$52,2,FALSE)),$F" & iCell7.Row & ")"
        End If
    Next iCell7
End If

'Code for column J
Dim AffectedRange8 As Range
Set AffectedRange8 = Intersect(Target, Me.Range("J2:J" & Me.Rows.Count))

If Not AffectedRange8 Is Nothing Then
    Dim iCell8 As Range
    For Each iCell8 In AffectedRange8.Cells

            If iCell8.Value = vbNullString Then
            iCell8.Formula = "=IFERROR(IF($I" & iCell8.Row & "="""","""",VLOOKUP($I" & iCell8.Row & ",'Raw Data'!$A$1:$AH$5000,2,FALSE)),""N/A"")"
        End If
    Next iCell8
End If

'Code for column K
Dim AffectedRange9 As Range
Set AffectedRange9 = Intersect(Target, Me.Range("K2:K" & Me.Rows.Count))

If Not AffectedRange9 Is Nothing Then
    Dim iCell9 As Range
    For Each iCell9 In AffectedRange9.Cells

            If iCell9.Value = vbNullString Then
            iCell9.Formula = "=IFERROR(IF($I" & iCell9.Row & "="""","""",IF(SUBSTITUTE(VLOOKUP($I" & iCell9.Row & ",'Raw Data'!$A$1:$AH$5000,13,FALSE),"","","""")<>"""",SUBSTITUTE(VLOOKUP($I" & iCell9.Row & ",'Raw Data'!$A$1:$AH$5000,13,FALSE),"","",""""),""N/A"")),""N/A"")"
        End If
    Next iCell9
End If

'Code for column L
Dim AffectedRange10 As Range
Set AffectedRange10 = Intersect(Target, Me.Range("L2:L" & Me.Rows.Count))

If Not AffectedRange10 Is Nothing Then
    Dim iCell10 As Range
    For Each iCell10 In AffectedRange10.Cells

            If iCell10.Value = vbNullString Then
            iCell10.Formula = "=IFERROR(IF($I" & iCell10.Row & "="""","""",SUBSTITUTE(VLOOKUP($I" & iCell10.Row & ",'Raw Data'!$A$1:$AH$5000,20,FALSE),"","","""")),""N/A"")"
        End If
    Next iCell10
End If

'Code for column M
Dim AffectedRange11 As Range
Set AffectedRange11 = Intersect(Target, Me.Range("M2:M" & Me.Rows.Count))

If Not AffectedRange11 Is Nothing Then
    Dim iCell11 As Range
    For Each iCell11 In AffectedRange11.Cells

            If iCell11.Value = vbNullString Then
            iCell11.Formula = "=IFERROR(IF($I" & iCell11.Row & "="""","""",VLOOKUP($I" & iCell11.Row & ",'Raw Data'!$A$1:$AH$5000,22,FALSE)),""N/A"")"
        End If
    Next iCell11
End If

'Code for column N
Dim AffectedRange12 As Range
Set AffectedRange12 = Intersect(Target, Me.Range("N2:N" & Me.Rows.Count))

If Not AffectedRange12 Is Nothing Then
    Dim iCell12 As Range
    For Each iCell12 In AffectedRange12.Cells

            If iCell12.Value = vbNullString Then
            iCell12.Formula = "=IFERROR(IF($I" & iCell12.Row & "="""","""",""1.""&VLOOKUP($I" & iCell12.Row & ",'Raw Data'!$A$1:$AH$5000,21,FALSE)),""N/A"")"
        End If
    Next iCell12
End If

'Code for column W
Dim AffectedRange13 As Range
Set AffectedRange13 = Intersect(Target, Me.Range("W2:W" & Me.Rows.Count))

If Not AffectedRange13 Is Nothing Then
    Dim iCell13 As Range
    For Each iCell13 In AffectedRange13.Cells

            If iCell13.Value = vbNullString Then
            iCell13.Formula = "=IF($I" & iCell13.Row & "="""","""",IFERROR(IF(VLOOKUP($I" & iCell13.Row & ",'Raw Data'!$A$1:$AH$5000,1,FALSE)=$I" & iCell13.Row & ",""yes"",""no""),""no""))"
        End If
    Next iCell13
End If
End sub

在此先感谢您的任何建议和帮助！

最好的问候， 奥利弗

【问题讨论】：

  • 看起来你的处理程序是可重入的； Application.EnableEvents = False 在顶部，Application.EnableEvents = True 在底部。
  • @MathieuGuindon 如果它是可重入的，那意味着什么？我在这背后的想法是我在运行删除行的其他代码时关闭了Worksheet_Change，一旦删除了行，Worksheet_Change 应该再次工作。但也许我犯了一个思维错误......
  • 抱歉，我承认我没有阅读整面文本......基本上没有禁用工作表事件，修改它被触发的工作表的Worksheet_Change 处理程序将递归。如果递归比 VBA 可以处理的更深，预计 Excel 会彻底崩溃：您必须防止从其处理程序重新触发事件......无论递归是否与手头的问题有关。
  • 您的代码不会检查 Col I 中的更改，因此您可以为此添加一个块。
  • 对不起，我不在办公室，所以我可以处理文件。我只是想将整个“Worksheet_Change”子更改为可以通过按钮激活的常规子。那行得通吗？如果是这样，我需要如何更改 'Intersect(Target, Me.Range("I2:I" & Me.Rows.Count))' 部分？

标签： excel vba optimization


【解决方案1】：

您的代码不会检查 Col I 中的更改，因此您可以为此添加一个块

'Code for column B
Dim AffectedRange As Range
Set AffectedRange = Intersect(Target, Me.Range("I2:I" & Me.Rows.Count))

If Not AffectedRange Is Nothing Then
    Dim iCell As Range
    For Each iCell In AffectedRange.Cells
        Application.EnableEvents=false
        'Note the Range is *relative* to EntireRow
        iCell.EntireRow.range("B1:H1,J1:M1").value = 1 'set an initial value
        Application.EnableEvents=True
        'Then trigger a change to set the formulas
        iCell.EntireRow.range("B1:H1,J1:M1").ClearContents
    Next iCell
End I

【讨论】：

    猜你喜欢
    • 2018-06-21
    • 1970-01-01
    • 2011-05-19
    • 2020-04-02
    • 2016-01-22
    • 1970-01-01
    • 1970-01-01
    • 2021-04-28
    相关资源
    最近更新 更多
    热门标签
    Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode