麻烦老师，帮我将这段代码合并下，谢谢

huangjinyui

麻烦老师，帮我将这段代码合并下，谢谢
代码1：
Private Sub Worksheet_Change(ByVal T As Range)    '私有的子程序 工作表_Change(变量T 为 单元格区域)
If T.Count > 1 Then Exit Sub    '如果  T的计数值>1 则执行 退出子程序
Dim f As Object, s As Object, i As Integer, i1 As Integer, i2 As Integer, arr(), dic As New Dictionary    '定义变量 f 为 对象,s 为 对象,i 为 整型值,i1 为 整型值,i2 为 整型值,arr(),dic 为  新的 字典
If T.Address = "$L$2" Then    '如果  T的地址="$L$2" 则执行
  Set f = GetObject(ThisWorkbook.Path & "\" & T.Value & ".xls")    '设定f=<获取对象>( 当前工作簿的路径 & "\" &  T的值 & ".xls")
  Sheets("分析考试名称").Range("A:A").Clear    '<工作表>("分析考试名称" )的<单元格>区域("A:A" )的清除
  For Each s In f.Sheets    '设定变量范围为每一个s位于 f的表单集合
    i = i + 1    'i=i+1
    Sheets("分析考试名称").Cells(i, 1) = s.Name    '<工作表>("分析考试名称" )的<单元格>坐标(i,1)= s的名称
  Next    '下一个
  f.Close    ' f的关闭
  Set f = Nothing    '设定 f=空值
  Set s = Nothing    '设定s=空值
ElseIf T.Address = "$R$2" Then    '另外如果 T的地址="$R$2" 则执行
  Set f = GetObject(ThisWorkbook.Path & "\" & Range("$L$2").Value & ".xls")    '设定f=<获取对象>( 当前工作簿的路径 & "\" & <单元格>区域("$L$2" )的值 & ".xls")
  arr = f.Sheets(T.Value).UsedRange.Value    'arr= f的<工作表>( T的值 )的已使用区域的值
  Set f = Nothing    '设定f=空值
  With Sheets("工作表")   '此为要清除原有数据的，如果是添加在后面的话，请用下面那行的被注释了的    '工作于<工作表>("工作表")'此为要清除原有数据的,如果是添加在后面的话,请用下面那行的被注释了的
      .[A:Q].Clear    '<With对象>的Cells.Clear
      .Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr    '<With对象>的<单元格>坐标(1,1 )的<重调大小>(<数组上限>(arr,1),<数组上限>(arr,2))=arr
  End With    'With语句结束
  'Sheets("工作表").Cells(65536, 1).End(xlUp)(2, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr '如果用这行，请将上面四行注释掉
  For i = 1 To UBound(arr)    '设定变量范围为i=1到<数组上限>(arr)
     dic(arr(i, 1)) = ""    'dic(arr(i,1))=空值
  Next    '下一个
  dic.Remove ("")    ' dic的移除 ("")
  With Sheets("分析班别表")    '工作于<工作表>("分析考试名称")
      .[b:b].Clear    '<With对象>的[b :b]的清除
      .[B1].Resize(dic.Count).Value = Application.Transpose(dic.Keys)    '<With对象>的[R4].<重调大小>( Dic的计数值 )的值= 应用程序的<区域转置>( Dic的关键字)
     .[B1].Resize(dic.Count).Sort key1:=.[B1], order1:=1, Header:=xlNo    '<With对象>的[R4].<重调大小>( Dic的计数值 )的排序 关键字1=<With对象>的[R4],order1=1,标题=xlNo
End With    'With语句结束
    dic.RemoveAll    ' Dic的RemoveAll
  Application.EnableEvents = True    '开启事件响应
End If    'If判断过程结束
End Sub    '子程序结束

代码2

• Private Sub Worksheet_Change(ByVal Target As Range)
• Dim rng As Range
• Set rng = Union([c14:c22], [c31:c39])
•     If Target.Address = "$E$11" Then
•         Application.ScreenUpdating = False
•         Dim r As Range
•         Cells.EntireRow.Hidden = False
•         For Each r In rng
•             If r.Value = 0 Then r.EntireRow.Hidden = True
•         Next
•         Application.ScreenUpdating = True
•     End If
• End Sub
  

先谢谢老师，谢谢

hwc2ycy

1. 
   
2. Private Sub Worksheet_Change(ByVal T As Range)    '私有的子程序 工作表_Change(变量T 为 单元格区域)
   
3.     Dim rng As Range
   
4.    
   
5.     Set rng = Union([c14:c22], [c31:c39])
   
6.    
   
7.     If T.Count > 1 Then Exit Sub    '如果  T的计数值>1 则执行 退出子程序
   
8.     Dim f As Object, s As Object, i As Integer, i1 As Integer, i2 As Integer, arr(), dic As New Dictionary    '定义变量 f 为 对象,s 为 对象,i 为 整型值,i1 为 整型值,i2 为 整型值,arr(),dic 为  新的 字典
   
9.     If T.Address = "$L$2" Then    '如果  T的地址="$L$2" 则执行
   
10.         Set f = GetObject(ThisWorkbook.Path & "" & T.Value & ".xls")    '设定f=<获取对象>( 当前工作簿的路径 & "" &  T的值 & ".xls")
    
11.         Sheets("分析考试名称").Range("A:A").Clear    '<工作表>("分析考试名称" )的<单元格>区域("A:A" )的清除
    
12.             For Each s In f.Sheets    '设定变量范围为每一个s位于 f的表单集合
    
13.                 i = i + 1    'i=i+1
    
14.                 Sheets("分析考试名称").Cells(i, 1) = s.Name    '<工作表>("分析考试名称" )的<单元格>坐标(i,1)= s的名称
    
15.             Next    '下一个
    
16.         f.Close    ' f的关闭
    
17.         Set f = Nothing    '设定 f=空值
    
18.         Set s = Nothing    '设定s=空值
    
19.     ElseIf T.Address = "$R$2" Then    '另外如果 T的地址="$R$2" 则执行
    
20.             Set f = GetObject(ThisWorkbook.Path & "" & Range("$L$2").Value & ".xls")    '设定f=<获取对象>( 当前工作簿的路径 & "" & <单元格>区域("$L$2" )的值 & ".xls")
    
21.             arr = f.Sheets(T.Value).UsedRange.Value    'arr= f的<工作表>( T的值 )的已使用区域的值
    
22.             Set f = Nothing    '设定f=空值
    
23.             With Sheets("工作表")   '此为要清除原有数据的，如果是添加在后面的话，请用下面那行的被注释了的    '工作于<工作表>("工作表")'此为要清除原有数据的,如果是添加在后面的话,请用下面那行的被注释了的
    
24.                 .[A:Q].Clear    '<With对象>的Cells.Clear
    
25.                 .Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr    '<With对象>的<单元格>坐标(1,1 )的<重调大小>(<数组上限>(arr,1),<数组上限>(arr,2))=arr
    
26.             End With    'With语句结束
    
27.             'Sheets("工作表").Cells(65536, 1).End(xlUp)(2, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr '如果用这行，请将上面四行注释掉
    
28. 
    
29.             For i = 1 To UBound(arr)    '设定变量范围为i=1到<数组上限>(arr)
    
30.                 dic(arr(i, 1)) = ""    'dic(arr(i,1))=空值
    
31.             Next    '下一个
    
32.             dic.Remove ("")    ' dic的移除 ("")
    
33.             With Sheets("分析班别表")    '工作于<工作表>("分析考试名称")
    
34.                 .[b:b].Clear    '<With对象>的[b :b]的清除
    
35.                 .[B1].Resize(dic.Count).Value = Application.Transpose(dic.Keys)    '<With对象>的[R4].<重调大小>( Dic的计数值 )的值= 应用程序的<区域转置>( Dic的关键字)
    
36.                 .[B1].Resize(dic.Count).Sort key1:=.[B1], order1:=1, Header:=xlNo    '<With对象>的[R4].<重调大小>( Dic的计数值 )的排序 关键字1=<With对象>的[R4],order1=1,标题=xlNo
    
37.             End With    'With语句结束
    
38.             dic.RemoveAll    ' Dic的RemoveAll
    
39.             Application.EnableEvents = True    '开启事件响应
    
40.     'End If    'If判断过程结束
    
41.     ElseIf Target.Address = "$E$11" Then
    
42.         Application.ScreenUpdating = False
    
43.         Dim r As Range
    
44.         Cells.EntireRow.Hidden = False
    
45.         For Each r In rng
    
46.             If r.Value = 0 Then r.EntireRow.Hidden = True
    
47.         Next
    
48.         Application.ScreenUpdating = True
    
49.     End If
    
50. End Sub    '子程序结束

复制代码

hwc2ycy

楼主，试试看看成不。

huangjinyui

hwc2ycy 发表于 2012-10-13 19:41
楼主，试试看看成不。

老师，谢谢，但运行不了，运行时出错

运行出错　424

hwc2ycy

什么提示？

hwc2ycy

把你的附件传上来吧。
我当时没做测试的，只是合并了代码。

huangjinyui

hwc2ycy 发表于 2012-10-14 21:50
把你的附件传上来吧。
我当时没做测试的，只是合并了代码。

老师，附件太大，不好上传，可以发上你邮箱给你吗？谢谢