求助，求助，如何实现自动打√的效果！

张振龙

如何在工作簿中的某张工作表里，对已经隐藏的工作表对应的表名不打√号，对没有隐藏的其他工作表名称对应的表名自动打√号。

LIUZHU

工作表遍历，获取工作表的隐藏属性存入字典，然后再数组循环不久可以了

user湫

随便凑了一下代码 将这个代码放入thisworkbook 中

1. Private Sub Workbook_Open()
   
2.     Call VisibleSht
   
3. End Sub
   
4. Function RemoveNumbersAndHyphens(s As String) As String
   
5.     Dim regex As Object
   
6.     Set regex = CreateObject("VBScript.RegExp")
   
7.     regex.Global = True
   
8.     regex.Pattern = "[0-9-]"
   
9.     RemoveNumbersAndHyphens = regex.Replace(s, "")
   
10. End Function
    
11. Function VisibleSht()
    
12.     Dim hiddenSheets() As String
    
13.     Dim i As Integer
    
14.     On Error Resume Next '忽略错误
    
15.     Excel.Application.ScreenUpdating = False
    
16.     Sheet1.Cells.Replace What:="√", Replacement:=""
    
17.     i = 0
    
18.     For Each sht In Sheets
    
19.         If Not sht.Visible Then
    
20.             ReDim Preserve hiddenSheets(i)
    
21.             hiddenSheets(i) = sht.Name
    
22.             i = i + 1
    
23.         End If
    
24.     Next
    
25.     '循环定位数据
    
26.     For j = LBound(hiddenSheets) To UBound(hiddenSheets)
    
27.         txt = RemoveNumbersAndHyphens(hiddenSheets(j))
    
28.         Set rng = Sheet1.Cells.Find(What:=txt)
    
29.         If Not rng Is Nothing Then
    
30.             rng.Offset(0, 1).Value = "√"
    
31.         Else
    
32.             Debug.Print "Value not found in " & hiddenSheetName
    
33.         End If
    
34.     Next
    
35.     Excel.Application.ScreenUpdating = True
    
36. End Function
    
37. 
    

复制代码

user湫

还可以通过代码，在插入一个按钮实现更新

user湫

可以去修改一下

ykcbf1100

user湫 发表于 2024-4-13 18:16
随便凑了一下代码 将这个代码放入thisworkbook 中

你这代码是随便写的？风格上看应该是GPT写的吧。

user湫

ykcbf1100 发表于 2024-4-13 20:52
你这代码是随便写的？风格上看应该是GPT写的吧。

嗯 就是进行拼接 自己改了一部分

3190496160

Sub 标识()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim sh As Worksheet
For Each sh In Sheets
    If sh.Name <> "目录" Then
        If sh.Visible = True Then
            d(sh.Name) = ""
        End If
    End If
Next sh
With Sheets("目录")
     r = .Cells(Rows.Count, 1).End(xlUp).Row
     .Range("c5:c" & r) = Empty
     For i = 5 To r
        mc = .Cells(i, 1) & .Cells(i, 2)
        If d.exists(mc) Then
            .Cells(i, 3) = "√"
        End If
    Next i
End With
MsgBox "ok!"
End Sub

3190496160

示例.rar (476.23 KB, 下载次数: 18)

2024-4-14 09:26 上传

点击文件名下载附件