小程序练习

OKJSJSF

小程序.rar (493.36 KB, 下载次数: 65)

2020-3-4 22:33 上传

点击文件名下载附件

这段时间在练习小程序，对excel阅读模式与高亮模式进行更改,其中“会议助手”功能计划用于单位开会时让坐在会议室后面的人能看清单元格中的值（不知为什么原条件格式功能中不能设置字号？）。操作者也可以把单元格调得足够小，让离屏幕最近者也看不清屏幕非活动格子中的内容，仅看清活动格子通过表单控件展示的内容。其中还有几个功能，如图片工具与去重计数，这些都是办公人员最实用的节省“眼力”的功能，准备完成后保存为加载宏，不知能否实现。补充了一些后再补充再改改一个错别字加了单元格去重计数数据区域多行去重计数完成，但还不是程序，还不是加载宏文件，图片重叠的解决办法还没找到，细节的东西还没改。列表去重计行数又发现一句错，改了[attach]2447786[/attach可见行去重计数又改了一个错已改为加载宏工作簿。对会议助手显示大字稍作改进。   小程序（加载宏工作簿）基本完工，包括视力工具、图形工具、去重计数三个选项组，自我感觉有点意思，请下载使用者对VBA工程进行保护，防止出错时误入工程删除代码。恳请各位前辈多指导，一个人弄的东西肯定还有自己未能发现的错误。工作表中的插图，如果图数量多，如何提速，能否把图先导入集合再插入工作表，象数组一样？图片批量对齐后在一个单元格中重叠的情况已进行提示。如何不管格式只按名称批量插图？其中按名称批量插图的代码如何把二段合并为一段（一段是插入第一列的代码、另一段是插入第二至五列的代码），我用了IIF函数，或if then end if语句对图片文件名进行变量转化都没成功。匹配批量插入图片决定采用常用的JPG格式，不必插入同名称的多种格式图片，防止重叠。修改了视力工具的多重选定区域与去重计数的冲突，修改了工作簿与表保护对选区不重复行数统计的影响，恢复会议助手的表单控件按活动单元格右下角位置确定（按窗体宽高确定位置难搞定）再更新。去重计行数有待完善！采用数组、字典与正则表达式进行去重计行数再更新2020-3-4







补充内容 (2020-3-22 14:40):
本楼已不能更新，如下载，请至最末页倒查。

补充内容 (2021-5-8 20:43):
20210508最新链接: https://pan.baidu.com/s/1p4QkoSty4JJ6tbzyWHbdmw 提取码: zprr 复制这段内容后打开百度网盘手机App，操作更方便哦

补充内容 (2021-5-8 22:04):
20210508最新链接: https://pan.baidu.com/s/1QI4BTjAZP3SgwJyLwcnwoQ 提取码: jad5 复制这段内容后打开百度网盘手机App，操作更方便哦

补充内容 (2021-5-23 14:35):
删除了可能有破坏性的自动备份功能，增加了创建连接与透视表功能。20210523最新链接: https://pan.baidu.com/s/1UZ3L51E6BO8lknzA_q0XOg 提取码: 741i 复制这段内容后打开百度网盘手机App，操作更方便哦

补充内容 (2021-6-19 19:50):
对记录单增加A4纸打印边界指示与标题显示，增加单元格删除数字、字母、汉字功能20210619最新链接: https://pan.baidu.com/s/1r4GKRIAHN1eSvz2HQsAmgQ 提取码: s3re 复制这段内容后打开百度网盘手机App，操作更方便哦

补充内容 (2023-3-30 21:19):
对加载宏小程序再作简化。链接: https://pan.baidu.com/s/1KMXvglbOl2_KjdDBw5pt_g 提取码: vwhq 复制这段内容后打开百度网盘手机App，操作更方便哦

补充内容 (2023-3-30 21:34):
60楼可以直接下载上传的excel加载宏小程序压缩文件，不必通过百度网盘了。

补充内容 (2023-4-1 21:37):
上传的excel加载宏压缩文件跑到61楼了。

补充内容 (2023-6-6 18:52):
想试用请62楼下载最新的。

补充内容 (2023-6-10 19:53):
想试用的请64楼下载。一是增加了一个功能：单元格信息展示。二是对视力工具中的会议助手功能进行增加，当单元格字符超过32个时，用窗体展示，字号仍采用72号大字。

补充内容 (2023-6-11 19:24):
想试用请62楼下载。不知怎么回事，文件一会儿从62楼变为64楼，一会儿又回到62楼。

补充内容 (2024-6-9 10:49):
增加了一个 用表格的“全行数据一览无余”功能。

补充内容 (2024-6-13 22:13):
罪过！这么长时间没发现使用交集intersect( , )时没防好错。

补充内容 (2024-9-13 12:47):
修改了几个文本清理过程中的格式设置

OKJSJSF

还需增加的功能是，如何让激活单元格总是滚动显示在窗口中间？

OKJSJSF

须解决图片重新排列时位置不变的问题。

OKJSJSF

如何获取图片坐标？

OKJSJSF

明天先做去重计数。图形批量对齐功能的一个单元格中图形重叠的问题另想办法解决。

OKJSJSF

由于手工插入单元格中图形时，可能一个格子中被插了多个图，图形重叠的解决办法，最好是图形左上角仍然位于原单元格中，从底层向上层，依次增加左边距与上边距，大小则一致按单元格。这样方便辨认处理。

OKJSJSF

Sub xyz()
    Dim ran As Range, mr As Range, ran2 As Range, k As Integer
    On Error GoTo errline
    Set ran = Application.InputBox("请选择待统计的单元格区域（连续非多重）", "数据设置", , , , , , 8)
    For Each mr In ran
        If ran2 Is Nothing Then
            Set ran2 = mr
        Else
            Set ran2 = Application.Union(ran2, mr)
        End If
        If Application.WorksheetFunction.CountIf(ran2, mr) = 1 Then
            k = k + 1
        End If
    Next
    MsgBox "单列不重复值个数（含筛选、隐藏、空格、换行符等）：" & k
errline:
End Sub

OKJSJSF

Sub xyz()
    If MsgBox("选择二个以上单元格后单击，可以统计出可见单元格中不重复值的个数。（注意事项：不计筛选、隐藏，也不计空格、真空，但要统计换行符等非打印字符）", vbOKCancel + vbInformation, "功能说明：") <> vbOK Then Exit Sub
    Dim myran As Range, myran2 As Range, mycoll As New Collection, i As Integer
    On Error GoTo errline
    Set myran = Application.InputBox("请选择待统计的单元格区域(任意)", "数据设置", , , , , , 8)
    myran.Select
    If myran.Count = 1 Then Exit Sub
    On Error Resume Next
    For Each myran2 In myran.SpecialCells(xlCellTypeVisible)
        If Trim(myran2) <> "" Then
            mycoll.Add myran2, Key:=CStr(myran2)
        End If
    Next
    MsgBox "选区不重复值个数： " & mycoll.Count, , "计算结果："
    Set myran = Nothing
    Set myran2 = Nothing
errline:
End Sub

OKJSJSF

用集合collection统计不重复值好像比其他办法爽。

zpy2

OKJSJSF 发表于 2020-1-29 22:40
用集合collection统计不重复值好像比其他办法爽。

一般情况下，字典估计比集合会速度快那么一点。