Vba 重叠宏

首先，我很抱歉发了这么长的帖子，并提前向您表示感谢！我一直在做一个项目，到目前为止，我有两个宏，其中只有一个在运行，另一个不是因为重叠

所以当从下拉列表中选择案例时，第一个宏隐藏一些特定的行（和列，但这不是我的问题）

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 1 Then Exit Sub
    Application.EnableEvents = False
      Select Case Target.Text
      Case "Case 1"
          ActiveSheet.Range("K:W").EntireColumn.Hidden = True
          ActiveSheet.Rows("5:150").EntireRow.Hidden = True
          ActiveSheet.Range("K:K").EntireColumn.Hidden = False
          ActiveSheet.Range("L:L").EntireColumn.Hidden = False
          ActiveSheet.Range("M:M").EntireColumn.Hidden = False
          ActiveSheet.Range("N:N").EntireColumn.Hidden = False
          ActiveSheet.Range("O:O").EntireColumn.Hidden = False
          ActiveSheet.Rows("5:50").EntireRow.Hidden = False
      Case "Case 2"
          ActiveSheet.Range("K:W").EntireColumn.Hidden = True
          ActiveSheet.Rows("5:150").EntireRow.Hidden = True
          ActiveSheet.Range("P:P").EntireColumn.Hidden = False
          ActiveSheet.Range("Q:Q").EntireColumn.Hidden = False
          ActiveSheet.Range("R:R").EntireColumn.Hidden = False
          ActiveSheet.Range("S:S").EntireColumn.Hidden = False
          ActiveSheet.Range("T:T").EntireColumn.Hidden = False
          ActiveSheet.Rows("51:100").EntireRow.Hidden = False
    End Select
    Application.EnableEvents = True
    End Sub

这就是宏观

Private Sub Worksheet_Change()
Dim RgToMerge As String
Dim i As Double
For i = 5 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
    RgToMerge = ""
    If LCase(Cells(i, 4)) <> "update" Or (LCase(Cells(i + 1, 4)) <> "new" And Cells(i + 1, 4) <> "") Then
    Else
        RgToMerge = "$C$" & Cells(i, 3).End(xlUp).Row & ":$C$" & i
        With Range(RgToMerge)
            .merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    End If

Next i

End Sub

Private子工作表\u Change（）
暗RGT变为字符串
我是双人的
对于i=5的ActiveSheet.Cells（Rows.Count，4）.End（xlUp）.Row
RgToMerge=“”
如果LCase（单元格（i，4））“更新”或（LCase（单元格（i+1，4））“新建”和单元格（i+1，4）”），则
其他的
RgToMerge=“$C$”&单元格（i，3）。结束（xlUp）。行和“：$C$”&i
带量程（RgToMerge）
合并
.HorizontalAlignment=xlCenter
.垂直对齐=xlCenter
以
如果结束
接下来我
端接头

如果没有隐藏行，则此代码可以完美工作。 现在问题是,；如果在第一个宏上选择了第二种情况，则将隐藏从5到50的行。此时，每当激活第二个宏时，它就会将所有C列合并到一个列中（包括隐藏行）

是否需要重写这两个脚本以使它们协同工作

让你试试这个（避免隐藏行）？：

Private子工作表\u Change（）
暗RGT变为字符串
我是双人的
对于i=5的ActiveSheet.Cells（Rows.Count，4）.End（xlUp）.Row
如果ActiveSheet.Rows（i）.EntireRow.Hidden为False，则
其他的
RgToMerge=“”
如果LCase（单元格（i，4））“更新”或（LCase（单元格（i+1，4））“新建”和单元格（i+1，4）”），则
其他的
“我不知道这对隐藏行是否能正常工作
RgToMerge=“$C$”&单元格（i，3）。结束（xlUp）。行和“：$C$”&i
带量程（RgToMerge）
合并
.HorizontalAlignment=xlCenter
.垂直对齐=xlCenter
以
如果结束
如果结束
接下来我
端接头

或者这个（扫描行、全部显示、合并、隐藏隐藏的行）

Private子工作表\u Change（）
Application.ScreenUpdating=False
Dim Th（）
ReDim Th（ActiveSheet.Cells（Rows.Count，4）.End（xlUp.Row）
'用隐藏的行状态填充数组
对于i=1至UBound（Th）
如果ActiveSheet.Rows（i）.EntireRow.Hidden为False，则
Th（i）=真
其他的
Th（i）=假
如果结束
接下来我
'显示所有行
ActiveSheet.Rows（“1:&UBound（Th））.EntireRow.Hidden=False
“合并
暗RGT变为字符串
我是双人的
对于i=5至UBound（Th）
RgToMerge=“”
如果LCase（单元格（i，4））“更新”或（LCase（单元格（i+1，4））“新建”和单元格（i+1，4）”），则
其他的
RgToMerge=“$C$”&单元格（i，3）。结束（xlUp）。行和“：$C$”&i
带量程（RgToMerge）
合并
.HorizontalAlignment=xlCenter
.垂直对齐=xlCenter
以
如果结束
接下来我
'重新隐藏以前隐藏的行
对于i=1至UBound（Th）
ActiveSheet.Rows（i）.EntireRow.Hidden=Th（i）
接下来我
Application.ScreenUpdating=True
端接头

我认为最简单的解决方案是再次显示行，进行合并，然后再次隐藏它们。至少这是一种方法，但可能有一种更“干净”的解决方案。这两个工作表更改宏是否都位于同一工作表代码模块中？不，隐藏行脚本在模块1中，而另一个case宏在工作表对象中（有多个工作表）。即使周围有隐藏行，它也像一种魅力：）！但它无法识别更改并自动将其合并。我知道如果我添加“私有子工作表_Change（ByVal Target As Range）”，它将是自动的，但我不能在不同的宏中使用两次。您有什么建议吗？哪些更改不被认可？如果你想一次又一次地重复使用相同的合并，你首先需要检测合并的单元格以避免它们。但我不知道如何用心去做^^您提供的第一个脚本在%100中也可以使用一些隐藏行，但每当我在D列中键入“update”时，我都需要手动运行该脚本以执行操作（合并单元格）。它不会给已经合并的单元格带来任何问题，所以我想这部分是好的：）好的，那么你需要的是，自动启动合并宏，但是你已经有了一些改变？为什么你们不能把它们都放在那个里？我试着把它们放在不同的模块里，但它给了我错误。将它们放在“私有子工作表_Change（ByVal Target As Range）”的sheet object下，没有任何问题！非常感谢您！！：）

Private Sub Worksheet_Change()
Dim RgToMerge As String
Dim i As Double
For i = 5 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
    RgToMerge = ""
    If LCase(Cells(i, 4)) <> "update" Or (LCase(Cells(i + 1, 4)) <> "new" And Cells(i + 1, 4) <> "") Then
    Else
        RgToMerge = "$C$" & Cells(i, 3).End(xlUp).Row & ":$C$" & i
        With Range(RgToMerge)
            .merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    End If

Next i

End Sub

Private Sub Worksheet_Change()
Dim RgToMerge As String
Dim i As Double
For i = 5 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
    If ActiveSheet.Rows(i).EntireRow.Hidden <> False Then
    Else
        RgToMerge = ""
        If LCase(Cells(i, 4)) <> "update" Or (LCase(Cells(i + 1, 4)) <> "new" And Cells(i + 1, 4) <> "") Then
        Else
            'I don't know if this would work properly with hidden rows
            RgToMerge = "$C$" & Cells(i, 3).End(xlUp).Row & ":$C$" & i
            With Range(RgToMerge)
                .Merge
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
        End If
    End If
Next i

End Sub

Private Sub Worksheet_Change()
Application.ScreenUpdating = False
Dim Th()
ReDim Th(ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row)
'Fill array with hidden state of rows
For i = 1 To UBound(Th)
    If ActiveSheet.Rows(i).EntireRow.Hidden <> False Then
        Th(i) = True
    Else
        Th(i) = False
    End If
Next i
'Display all rows
ActiveSheet.Rows("1:" & UBound(Th)).EntireRow.Hidden = False

'Merge
Dim RgToMerge As String
Dim i As Double
For i = 5 To UBound(Th)
    RgToMerge = ""
    If LCase(Cells(i, 4)) <> "update" Or (LCase(Cells(i + 1, 4)) <> "new" And Cells(i + 1, 4) <> "") Then
    Else
        RgToMerge = "$C$" & Cells(i, 3).End(xlUp).Row & ":$C$" & i
        With Range(RgToMerge)
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    End If
Next i

'Rehide previously hidden rows
For i = 1 To UBound(Th)
    ActiveSheet.Rows(i).EntireRow.Hidden = Th(i)
Next i

Application.ScreenUpdating = True
End Sub