ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
12
返回列表 发新帖
楼主: 张振龙

[求助] 求助,求助,如何实现自动打√的效果!

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-4-14 09:28 | 显示全部楼层
目录中的名称是: 关联方及其交易声明书,而工作表名称却是:关联方及交易声明书,虽是一字之差,但是,肯定是差之毫厘谬以千里的

TA的精华主题

TA的得分主题

发表于 2024-4-14 09:50 | 显示全部楼层
附件供参考。。。

示例2.7z

502.66 KB, 下载次数: 12

TA的精华主题

TA的得分主题

发表于 2024-4-14 09:51 | 显示全部楼层
参与一下。。。

  1. Sub ykcbf() '//2024.4.14
  2.     Set ws = ThisWorkbook
  3.     Set sh = ws.Sheets("目录")
  4.     arr = sh.UsedRange
  5.     On Error Resume Next
  6.     For j = 1 To UBound(arr, 2) Step 3
  7.         For i = 4 To UBound(arr)
  8.             If Val(arr(i, j)) Then
  9.                 fn = arr(i, j) & arr(i, j + 1)
  10.                 If ws.Sheets(fn).Visible = -1 Then
  11.                     sh.Cells(i, j + 2) = "√"
  12.                 Else
  13.                     sh.Cells(i, j + 2) = ""
  14.                 End If
  15.             End If
  16.         Next
  17.     Next
  18.     MsgBox "OK!"
  19. End Sub
复制代码


评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-4-17 11:08 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
user湫 发表于 2024-4-13 18:20
可以去修改一下

感谢你的帮助。

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-4-17 11:11 | 显示全部楼层
user湫 发表于 2024-4-13 18:20
可以去修改一下

你改出来工作簿是我想要的效果,但有两个问题。1、代码需要修改:需求是隐藏的不打勾,保留的打勾。2、我不懂VBA,需要你详细讲下操作流程。  非常感谢帮我解决难题

TA的精华主题

TA的得分主题

发表于 2024-4-17 16:06 | 显示全部楼层
应该是这样吧,你可以看看 下面的代码就是gpt翻译的 具体我没有看,建议你自己在学习一下。不然还是看不懂。

示例.zip

221.13 KB, 下载次数: 9

TA的精华主题

TA的得分主题

发表于 2024-4-17 16:08 | 显示全部楼层
张振龙 发表于 2024-4-17 11:11
你改出来工作簿是我想要的效果,但有两个问题。1、代码需要修改:需求是隐藏的不打勾,保留的打勾。2、我 ...
  1. Function VisibleSht()
  2.     Dim hiddenSheets() As String  ' 声明一个字符串数组,用于存储隐藏工作表的名称
  3.     Dim i As Integer  ' 声明一个整型变量 i,用于迭代数组索引
  4.     On Error Resume Next  ' 设置错误处理方式为忽略错误,即出现错误时不中断程序执行
  5.     Excel.Application.ScreenUpdating = False  ' 禁用屏幕更新,以提高代码执行效率
  6.     Sheet1.Cells.Replace What:="√", Replacement:=""  ' 在工作表 Sheet1 的所有单元格中查找 "√" 并替换为空字符串
  7.     i = 0  ' 初始化数组索引计数器
  8.     For Each sht In Sheets  ' 遍历所有工作表
  9.         If sht.Visible Then  ' 检查当前工作表是否可见
  10.             ReDim Preserve hiddenSheets(i)  ' 调整 hiddenSheets 数组的大小以容纳新的工作表名称
  11.             hiddenSheets(i) = sht.Name  ' 将当前工作表的名称存储在 hiddenSheets 数组中
  12.             i = i + 1  ' 增加数组索引计数器
  13.         End If
  14.     Next
  15.     '循环定位数据
  16.     For j = LBound(hiddenSheets) To UBound(hiddenSheets)  ' 遍历 hiddenSheets 数组
  17.         txt = RemoveNumbersAndHyphens(hiddenSheets(j))  ' 调用 RemoveNumbersAndHyphens 函数来移除当前工作表名称中的数字和连字符,并将结果存储在变量 txt 中
  18.         Set Rng = Sheet1.Cells.Find(What:=txt)  ' 在工作表 Sheet1 的单元格中查找匹配 txt 的内容,并将结果存储在 Rng 对象中
  19.         If Rng Is Nothing Then  ' 检查是否找到了匹配项
  20.             Debug.Print "Value not found in " & hiddenSheets(j)  ' 如果未找到匹配项,则在调试窗口中打印相应的消息
  21.         Else  ' 如果找到了匹配项
  22.             Rng.Offset(0, 1).Value = "√"  ' 在找到的单元格的右侧单元格中写入 "√" 符号
  23.         End If
  24.     Next  ' 循环的下一次迭代
  25.     Excel.Application.ScreenUpdating = True  ' 启用屏幕更新
  26. End Function
复制代码

TA的精华主题

TA的得分主题

发表于 2024-4-17 16:09 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
张振龙 发表于 2024-4-17 11:11
你改出来工作簿是我想要的效果,但有两个问题。1、代码需要修改:需求是隐藏的不打勾,保留的打勾。2、我 ...
  1. 这段代码是用于 Excel VBA 的,主要实现了两个函数:

  2. 1. `RemoveNumbersAndHyphens` 函数用于移除字符串中的数字和连字符。
  3. 2. `VisibleSht` 函数用于将隐藏的工作表中包含的字符串(经过 `RemoveNumbersAndHyphens` 处理后)与另一个工作表中的数据进行匹配,并在匹配到的位置标记一个 "√" 符号。

  4. 现在让我来逐行解释代码:

  5. ```vba
  6. Function RemoveNumbersAndHyphens(s As String) As String
  7.     Dim regex As Object
  8.     Set regex = CreateObject("VBScript.RegExp")
  9.     regex.Global = True
  10.     regex.Pattern = "[0-9-]"
  11.     RemoveNumbersAndHyphens = regex.Replace(s, "")
  12. End Function
  13. ```
  14. - `Function RemoveNumbersAndHyphens(s As String) As String`: 定义了一个名为 `RemoveNumbersAndHyphens` 的函数,它接受一个字符串参数并返回一个字符串。
  15. - `Dim regex As Object`: 声明一个名为 `regex` 的对象变量,用于存储正则表达式对象。
  16. - `Set regex = CreateObject("VBScript.RegExp")`: 创建一个 VBScript 正则表达式对象。
  17. - `regex.Global = True`: 将正则表达式设置为全局匹配模式,以匹配字符串中的所有匹配项。
  18. - `regex.Pattern = "[0-9-]"`: 设置正则表达式的模式,该模式将匹配数字和连字符。
  19. - `RemoveNumbersAndHyphens = regex.Replace(s, "")`: 使用正则表达式对象将字符串中的数字和连字符替换为空字符串,并将结果赋值给函数的返回值。

  20. ```vba
  21. Function VisibleSht()
  22.     Dim hiddenSheets() As String
  23.     Dim i As Integer
  24.     On Error Resume Next '忽略错误
  25.     Excel.Application.ScreenUpdating = False
  26.     Sheet1.Cells.Replace What:="√", Replacement:=""
  27.     i = 0
  28.     For Each sht In Sheets
  29.         If sht.Visible Then
  30.             ReDim Preserve hiddenSheets(i)
  31.             hiddenSheets(i) = sht.Name
  32.             i = i + 1
  33.         End If
  34.     Next
  35.     '循环定位数据
  36.     For j = LBound(hiddenSheets) To UBound(hiddenSheets)
  37.         txt = RemoveNumbersAndHyphens(hiddenSheets(j))
  38.         Set Rng = Sheet1.Cells.Find(What:=txt)
  39.         If Rng Is Nothing Then
  40.             Debug.Print "Value not found in " & hiddenSheets(j)
  41.         Else
  42.             Rng.Offset(0, 1).Value = "√"
  43.         End If
  44.     Next
  45.     Excel.Application.ScreenUpdating = True
  46. End Function
  47. ```
  48. - `Function VisibleSht()`: 定义了一个名为 `VisibleSht` 的函数,它没有指定返回值类型,因此默认为 `Variant`。
  49. - `Dim hiddenSheets() As String`: 声明一个名为 `hiddenSheets` 的字符串数组,用于存储隐藏工作表的名称。
  50. - `Dim i As Integer`: 声明一个整型变量 `i`,用于迭代数组索引。
  51. - `On Error Resume Next`: 设置错误处理方式为忽略错误,即出现错误时不中断程序执行。
  52. - `Excel.Application.ScreenUpdating = False`: 禁用屏幕更新,以提高代码执行效率。
  53. - `Sheet1.Cells.Replace What:="√", Replacement:=""`: 在工作表 `Sheet1` 的所有单元格中查找 "√" 并替换为空字符串。
  54. - `For Each sht In Sheets`: 遍历所有工作表。
  55. - `If sht.Visible Then`: 检查当前工作表是否可见。
  56. - `ReDim Preserve hiddenSheets(i)`: 调整 `hiddenSheets` 数组的大小以容纳新的工作表名称。
  57. - `hiddenSheets(i) = sht.Name`: 将当前工作表的名称存储在 `hiddenSheets` 数组中。
  58. - `i = i + 1`: 增加数组索引计数器。
  59. - `For j = LBound(hiddenSheets) To UBound(hiddenSheets)`: 遍历 `hiddenSheets` 数组。
  60. - `txt = RemoveNumbersAndHyphens(hiddenSheets(j))`: 调用 `RemoveNumbersAndHyphens` 函数来移除当前工作表名称中的数字和连字符,并将结果存储在变量 `txt` 中。
  61. - `Set Rng = Sheet1.Cells.Find(What:=txt)`: 在工作表 `Sheet1` 的单元格中查找匹配 `txt` 的内容,并将结果存储在 `Rng` 对象中。
  62. - `If Rng Is Nothing Then`: 检查是否找到了匹配项。
  63. - `Debug.Print "Value not found in " & hiddenSheets(j)`: 如果未找到匹配项,则在调试窗口中打印相应的消息。
  64. - `Else`: 如果找到了匹配项。
  65. - `Rng.Offset(0, 1).Value = "√"`: 在找到的单元格的右侧单元格中写入 "√" 符号。
  66. - `Next`: 循环的下一次迭代。
  67. - `Excel.Application.ScreenUpdating = True`: 启用屏幕更新。
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-4-18 09:23 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-5-13 14:23 , Processed in 0.033471 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表