[已解决]帮忙控件修改

lwlw

这是一个查找控件，我现在又增加了四个新的工作表，当我点查找后新工作表不想加入到查找中，请问要怎么改，我想要的结果是只查找1月到12月的内容，新增加的表除外，谢谢帮忙

最佳答案

月排行榜 / 总排行榜

lisachen

2012-4-7 17:12

1. 
   
2. 
   
3. Private Sub CommandButton1_Click()
   
4.     Dim Arr11()
   
5.     BH = TextBox1.Value
   
6.     HZXM = TextBox2.Value
   
7.     For Each SHT In Sheets
   
8.         If SHT.Name Like "*月" Then
   
9.             With SHT
   
10.                 ROW1 = .Range("A" & .Rows.Count).End(xlUp).Row
    
11.                 Arr1 = .Range("A2:I" & ROW1)
    
12.                 For I = 1 To UBound(Arr1)
    
13.                     If Arr1(I, 1) = BH Or Arr1(I, 2) = HZXM Then
    
14.                         M = M + 1
    
15.                         ReDim Preserve Arr11(1 To 9, 1 To M)
    
16.                         Arr11(1, M) = SHT.Name
    
17.                         For J = 1 To 8
    
18.                             Arr11(J + 1, M) = Arr1(I, J)
    
19.                         Next J
    
20.                     End If
    
21.                 Next I
    
22.             End With
    
23.         End If
    
24.     Next SHT
    
25.     Sheets("查找").Select
    
26.     Sheets("查找").Range("A2").Resize(UBound(Arr11, 2), UBound(Arr11)) = Application.Transpose(Arr11)
    
27.     TextBox1.Value = ""
    
28.     TextBox2.Value = ""
    
29. End Sub

复制代码

学习-2.rar (38.89 KB, 下载次数: 1)

2012-4-7 17:14 上传

点击文件名下载附件

跳转到最佳答案楼层

lisachen

1. 
   
2. 
   
3. Private Sub CommandButton1_Click()
   
4.     Dim Arr11()
   
5.     BH = TextBox1.Value
   
6.     HZXM = TextBox2.Value
   
7.     For Each SHT In Sheets
   
8.         If SHT.Name Like "*月" Then
   
9.             With SHT
   
10.                 ROW1 = .Range("A" & .Rows.Count).End(xlUp).Row
    
11.                 Arr1 = .Range("A2:I" & ROW1)
    
12.                 For I = 1 To UBound(Arr1)
    
13.                     If Arr1(I, 1) = BH Or Arr1(I, 2) = HZXM Then
    
14.                         M = M + 1
    
15.                         ReDim Preserve Arr11(1 To 9, 1 To M)
    
16.                         Arr11(1, M) = SHT.Name
    
17.                         For J = 1 To 8
    
18.                             Arr11(J + 1, M) = Arr1(I, J)
    
19.                         Next J
    
20.                     End If
    
21.                 Next I
    
22.             End With
    
23.         End If
    
24.     Next SHT
    
25.     Sheets("查找").Select
    
26.     Sheets("查找").Range("A2").Resize(UBound(Arr11, 2), UBound(Arr11)) = Application.Transpose(Arr11)
    
27.     TextBox1.Value = ""
    
28.     TextBox2.Value = ""
    
29. End Sub

复制代码

学习-2.rar (38.89 KB, 下载次数: 1)

2012-4-7 17:14 上传

点击文件名下载附件

lwlw

lisachen 发表于 2012-4-7 17:12

唉！文盲真可怕，我这一句，我改了半天，感谢解决，我还有一个引用函数怎么结果是错的，你再帮我看看，我想要的结果是不出现同一个名字

lisachen

lwlw 发表于 2012-4-7 17:25
唉！文盲真可怕，我这一句，我改了半天，感谢解决，我还有一个引用函数怎么结果是错的，你再帮我看看，我 ...

1. =IF(ROW()<=ROUND(SUM(1/COUNTIF(Sheet1!$B$2:$B$14,Sheet1!$B$2:$B$14)),0),INDEX(Sheet1!$B$2:$B$14,SMALL(IF(MATCH(Sheet1!$B$2:$B$14,Sheet1!$B$2:$B$14,0)=ROW(Sheet1!$B$1:$B$13),ROW(Sheet1!$B$2:$B$14)),ROW())),"")

复制代码

=IF(ROW()<=ROUND(SUM(1/COUNTIF(Sheet1!$B$2:$B$14,Sheet1!$B$2:$B$14)),0),INDEX(Sheet1!$B$2:$B$14,SMALL(IF(MATCH(Sheet1!$B$2:$B$14,Sheet1!$B$2:$B$14,0)=ROW(Sheet1!$B$1:$B$13),ROW(Sheet1!$B$2:$B$14)),ROW())),"")
没简化

lisachen

时间比较紧要下班了 不知是不是这个意思