急求帮忙！auto_open+二级循环，恳请各位老师帮忙！非常感谢！

mineshine

tczone 发表于 2013-8-30 14:19
您好！在源代码指向的是test--的文件哦，请求老师再帮忙分析一下！谢谢了！

那你就只要修改 "Sub 删除指定内容()" 代码就行了

tczone

mineshine 发表于 2013-8-30 14:21
那你就只要修改 "Sub 删除指定内容()" 代码就行了

不好意思啊，老师，我刚学不久，请明示！谢谢您！

mineshine

tczone 发表于 2013-8-30 14:24
不好意思啊，老师，我刚学不久，请明示！谢谢您！

4楼代码有明示了
最后一段代码

1. 
   
2. Sub 删除指定内容()
   
3. R1 = Cells(Rows.Count, 2).End(xlUp).Row
   
4. AR = Cells(1, 2).Resize(R1)
   
5. For a = R1 To 5 Step -1
   
6.     If AR(a, 1) <> n Then
   
7.         If S1 Is Nothing Then
   
8.             Set S1 = Rows(a).EntireRow
   
9.             S1.Delete
   
10.         Else
    
11.             Set S1 = Union(S1, Rows(a).EntireRow)
    
12.         End If
    
13.     End If
    
14. Next a
    
15. [a1].Select
    
16. End Sub
    

复制代码

tczone

mineshine 发表于 2013-8-30 14:34
4楼代码有明示了
最后一段代码

老师，您好！已经修改为
Dim AR, R1&, a&, S1 As Range, n As String
Sub auto_open()
  
    Dim mCaidan As Menu
    MenuBars(xlWorksheet).Reset
    Set mCaidan = MenuBars(xlWorksheet).Menus.Add("system")
    With mCaidan.MenuItems
        .Add "循环工作表", "循环工作表"
    End With
End Sub
Sub 循环工作表()
On Error Resume Next
n$ = ActiveWorkbook.Name
n = Sheets("客户名称").[a1].Value
For Each sh In Workbooks("n$").Sheets
    If sh.Name <> "客户名称" Then
    sh.Activate
    Call 删除指定内容
End If
Next
End Sub

Sub 删除指定内容()
R1 = Cells(Rows.Count, 2).End(xlUp).Row
AR = Cells(1, 2).Resize(R1)
For a = R1 To 5 Step -1
    If AR(a, 1) <> n Then
        If S1 Is Nothing Then
            Set S1 = Rows(a).EntireRow
            S1.Delete
        Else
            Set S1 = Union(S1, Rows(a).EntireRow)
        End If
    End If
Next a
[a1].Select
End Sub
但是还是没有成功～～麻烦您了！

mineshine

tczone 发表于 2013-8-30 14:48
老师，您好！已经修改为
Dim AR, R1&, a&, S1 As Range, n As String
Sub auto_open()

我这里一定要指定工作簿
没有指定就是错的

真的旡能为力，抱歉了，希望有高手可以幇忙解決。

蓝桥玄霜

1. Dim AR, R1&, a&, S1 As Range, n As String, sh As Worksheet
   
2. Sub auto_open()
   
3.   
   
4.     Dim mCaidan As Menu
   
5.     MenuBars(xlWorksheet).Reset
   
6.     Set mCaidan = MenuBars(xlWorksheet).Menus.Add("system")
   
7.     With mCaidan.MenuItems
   
8.         .Add "循环工作表", "循环工作表"
   
9.     End With
   
10. End Sub
    
11. Sub 循环工作表()
    
12. On Error Resume Next
    
13. n$ = ActiveWorkbook.Name
    
14. n = Sheets("客户名称").[a1].Value
    
15. For Each sh In Workbooks("n$").Sheets
    
16.     If sh.Name <> "客户名称" Then
    
17.     sh.Activate
    
18.     Call 删除指定内容(sh)
    
19. End If
    
20. Next
    
21. End Sub
    
22. 
    
23. Sub 删除指定内容(sh)
    
24. R1 = sh.Cells(sh.Rows.Count, 2).End(xlUp).Row
    
25.    AR = sh.Cells(1, 2).Resize(R1)
    
26.    For a = 5 To R1
    
27.    If AR(a, 1) <> n Then
    
28.    If S1 Is Nothing Then
    
29.    Set S1 = sh.Rows(a).EntireRow
    
30.   Else
    
31.    Set S1 = Union(S1, sh.Rows(a).EntireRow)
    
32.    End If
    
33.    End If
    
34.    Next
    
35.    If Not S1 Is Nothing Then S1.Delete: Set S1 = Nothing
    
36. sh.[a1].Select
    
37. End Sub
    

复制代码

tczone

mineshine 发表于 2013-8-30 15:00
我这里一定要指定工作簿
没有指定就是错的

非常感谢mineshine 老师！

tczone

蓝桥玄霜 发表于 2013-8-30 15:04

谢谢！蓝版的帮忙！老师，我已经按照您的代码测试过了，还是没能达成目地，恳请老师再帮帮忙！

tczone

急求帮助！请各位老师帮忙！附件在3楼！非常感谢了！