Question

我在合并两个Worksheet_Change事件时遇到问题-请问一位专家可以给我一些建议吗？

该代码的目的是在给定小写字母的单元格范围内转换任何大写文本，但显然我不能有两个事件。

我尝试将它们都复制到同一Worksheet_Change中，但是Excel变得狂暴并崩溃了。

范围1：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ccr As Range
    Set ccr = Range("C6")
    For Each Cell In ccr
    Cell.Value = LCase(Cell)
    Next Cell
End Sub

范围2：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim acr As Range
    Set acr = Range("C9:G9")
    For Each Cell In acr
    Cell.Value = LCase(Cell)
    Next Cell
End Sub

非常感谢

Answer 1

主要问题是，更改单元格值<template lang="pug"> .div( :created="axiSync" ) h3 asyComp2 h1 {{statusText}} h1 {{status}} h3 {{stargazersCount}} h3 {{description}} h3 {{htmlUrl}} h3 {{ratelimit}} </template> <script lang="coffee"> import axios from 'axios' export default props: ['repo'] data: -> statusText: '' status: '' stargazersCount: '' description: '' htmlUrl: '' ratelimit: '' url: 'https://api.github.com/repos/userName/' methods: axiSync: -> response = await axios.get(@url + @repo) @statusText = response.statusText @status = response.status @stargazersCount = response.data.stargazers_count @description = response.data.description @htmlUrl = response.data.html_url @ratelimit = response.headers['x-ratelimit-remaining'] </script> ... asyComp2( repo = 'niceAndDandy' )将立即触发另一个Cell.Value。您需要Worksheet_Change来防止这种情况。

我还建议使用Application.EnableEvents = False，以便代码仅在实际更改的单元格上运行。

Intersect

除了@Frank Ball的注释（包括错误处理）：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim AffectedRange As Range
    Set AffectedRange = Intersect(Target, Target.Parent.Range("C6, C9:G9"))

    If Not AffectedRange Is Nothing Then
        Application.EnableEvents = False 'pervent triggering another change event

        Dim Cel As Range
        For Each Cel In AffectedRange.Cells
            Cel.Value = LCase$(Cel.Value)
        Next Cel

        Application.EnableEvents = True 'don't forget to re-enable events in the end
    End If
End Sub

Answer 2

两个Worksheet_Change事件是完全相同的，它们是一个围绕范围的循环，返回LCase()。因此，最好为此创建一个单独的Sub：

Sub FixRangeLCase(rangeToFix As Range)        
    Dim myCell As Range
    For Each myCell In rangeToFix
        myCell.Value2 = LCase(myCell.Value2)
    Next myCell    
End Sub

然后，向其引用Worksheet_Change事件。就Worksheet_Change事件而言，它总是很“昂贵”且始终运行，因此，只有在更改了特定目标单元格后才运行它，否则退出过程-If Intersect(Target, Range("C6"), Range("C9:G9")) Is Nothing Then Exit Sub

需要Application.EnableEvents = False才能禁用事件。最后将其设置回True。

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("C6"), Range("C9:G9")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    FixRangeLCase Range("C6")
    FixRangeLCase Range("C9:G9")
    Application.EnableEvents = True

End Sub

Answer 3

像这样，您可以在同一事件中同时做这两项事情

为避免出现竞争状况，您必须在开始时添加Application.EnableEvents = False。

Private Sub Worksheet_Change(ByVal Target As Range)
 Application.EnableEvents = False

    Dim ccr As Range, acr as Range

    Set ccr = Range("C6")
    For Each Cell In ccr
      Cell.Value = LCase(Cell)
    Next Cell

    Set acr = Range("C9:G9")
    For Each Cell In acr
      Cell.Value = LCase(Cell)
    Next Cell
 Application.EnableEvents = True

End Sub

Answer 4

您还可以使用：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, cell As Range

    Application.EnableEvents = False

        If Not Intersect(Target, Range("C6")) Is Nothing Or Not Intersect(Target, Range("C9:G9")) Is Nothing Then
            Set rng = Range("C9:G9", "C6")

            For Each cell In rng
                cell.Value = LCase(cell.Value)
            Next
        End If

    Application.EnableEvents = True

End Sub

VBA代码中的多个Worksheet_Change事件

4 个答案: