找到
16
篇与
Excel笔记
相关的结果
-
CostTools --更新日志 点击下载 CostTools 1.3 测试版 CostTools 1.3 测试 （1）工作表对比：对比同在一个工作簿的两个工作表不同的地方，并用底色标识。 （2）工作簿对比： （3）工作簿合并：合并工作簿 （4）工作簿拆分：拆分工作簿 （5）删除线 应用删线：文字添加删除线 隐藏本行：隐藏含删除线的行或者隐藏不含删除线的行 显示全行：隐藏后恢复显示所有内容 表格还原：还原到原始状态 导出未删除数据：导出画删除线以外的数据到新表 CostTools 1.2 2025.03.21 （1）公式转数值（区域）：选择特定的区域公式转为数值 （2）公式转数值（全表）：不在区分区域，整个表格或者整个工作簿有公式的全部转为数值 （3）常用公式：把常用公式写成按键，需要的时候选择单元格点击插入，不在记公式，配公式帮助文档说明用法。 （4）公式变色（红色）：表格内含公式的单元格文字字体变成红色 （5）公式恢复（黑色）：变色的公式字体恢复为黑色 （6）批量文件夹：批量生成文件夹 （7）批量改名：批量修改文件名 （8）修复部分BUG 造价工具 1.1 2025.03.15 （1）最适合的行高：去掉选择区域的选项，默认调整整个工作表 （2）高清截图：截取表格内容，可以实现长截图 （3）截图批注（本地）：插入本地图片到单元格批注 （4）清理截图（C盘）：清理截图的文件夹 （5）截图批注（测试）：截图，复制后选择单元格插入批注 （6）Excerl工作圈小工具：别人做的工具，以后都放这里 （7）计算式：不需要按钮，未放置，单元格内输入=计算式（）既可调出 （8）版本更新：增加版本更新按钮 造价工具 1.0 2025.03.09 （1）区间字变色：输入计算式【】内备注文字会特别显示 （2）隐藏0值：隐藏单元格内0值 （3）最适合的行高：在原来行高的基础上再次增加自己需要的行高 （4）合并单元格：多行文字合并为一个单元格内 （5）单元格历史动作：记录每一次单元格的修改记录 （6）生成目录：生成工作表目录 （7）帮助：一些简单的操作索引
-
WPS VBA插件简单使用教程（二） 修改代码增加区域选择，文字及括号颜色定义对话框： 完整代码： Option Explicit Function ConvertColor(ByVal colorStr As String, ByRef colorOut As Long) As Boolean Dim arrColor arrColor = Split(colorStr, ",") If UBound(arrColor) <> 2 Then MsgBox "颜色格式错误，请使用R,G,B格式！", vbCritical ConvertColor = False Exit Function End If On Error Resume Next Dim r As Long: r = CLng(Trim(arrColor(0))) Dim g As Long: g = CLng(Trim(arrColor(1))) Dim b As Long: b = CLng(Trim(arrColor(2))) On Error GoTo 0 If r < 0 Or r > 255 Or g < 0 Or g > 255 Or b < 0 Or b > 255 Then MsgBox "颜色数值必须在0-255之间！", vbCritical ConvertColor = False Exit Function End If colorOut = RGB(r, g, b) ConvertColor = TrueEnd Function Sub OptimizedColorAllTextInBrackets() Dim targetRange As Range Dim cell As Range Dim text As String Dim startPos As Long, endPos As Long Dim arrBrackets() As Variant Dim i As Long Dim defaultTextColor As Long Dim bracketTextColor As Long Dim colorInput As String ' 选择处理区域 On Error Resume Next Set targetRange = Application.InputBox("请选择要处理的区域", "区域选择", "F4:K10000", Type:=8) On Error GoTo 0 If targetRange Is Nothing Then Exit Sub ' 过滤空单元格 On Error Resume Next Set targetRange = targetRange.SpecialCells(xlCellTypeConstants) On Error GoTo 0 If targetRange Is Nothing Then MsgBox "所选区域没有内容！", vbInformation Exit Sub End If ' 颜色选择 colorInput = InputBox("普通文字颜色（格式：R,G,B）", "颜色选择", "0,0,0") If Not ConvertColor(colorInput, defaultTextColor) Then Exit Sub colorInput = InputBox("括号文字颜色（格式：R,G,B）", "颜色选择", "0,0,255") If Not ConvertColor(colorInput, bracketTextColor) Then Exit Sub ' 优化性能设置 With Application .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False .EnableAnimations = False End With For Each cell In targetRange ' 处理括号着色 text = cell.Value cell.Font.Color = defaultTextColor ' 设置整体文字颜色 If InStr(text, "【") > 0 Then ReDim arrBrackets(1 To Len(text) \ 2) startPos = InStr(text, "【") i = 0 Do While startPos > 0 endPos = InStr(startPos + 1, text, "】") If endPos > startPos Then i = i + 1 arrBrackets(i) = Array(startPos, endPos - startPos + 1) startPos = InStr(endPos + 1, text, "【") Else Exit Do End If Loop If i > 0 Then For startPos = 1 To i With cell.Characters(arrBrackets(startPos)(0), arrBrackets(startPos)(1)).Font .Color = bracketTextColor End With Next startPos End If End If Next cell ' 恢复系统设置 With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic .EnableEvents = True .EnableAnimations = True End With MsgBox "处理完成！共处理 " & targetRange.Count & " 个单元格", vbInformationEnd Sub 自动运行代码： ' Worksheet_Change事件处理Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo ErrorHandler Application.EnableEvents = False ' 限制处理范围并提升性能 Dim ProcessArea As Range Set ProcessArea = Me.Range("F4:K10000") ' 仅处理与目标区域有交集的单元格 Dim cell As Range For Each cell In Intersect(Target, ProcessArea) ' 排除空单元格和错误值 If Not IsError(cell.Value) Then ' 移除原有的0值处理逻辑 If InStr(cell.Value, "【") > 0 Then UpdateBracketColor cell, RGB(0, 0, 0), RGB(0, 0, 255) End If End If Next cell ExitHandler: Application.EnableEvents = True Exit SubErrorHandler: MsgBox "处理过程中发生错误：" & Err.Description & vbCrLf & "错误代码：" & Err.Number Resume ExitHandlerEnd Sub ' 优化后的括号处理函数Private Sub UpdateBracketColor(ByVal cell As Range, ByVal defColor As Long, ByVal brkColor As Long) On Error Resume Next ' 防止合并单元格出错 Dim text As String text = cell.Value cell.Font.Color = defColor ' 使用更高效的查找算法 Dim posOpen As Long, posClose As Long posOpen = InStr(1, text, "【") Do While posOpen > 0 posClose = InStr(posOpen + 1, text, "】") If posClose > 0 Then With cell.Characters(posOpen, posClose - posOpen + 1).Font .Color = brkColor End With posOpen = InStr(posClose + 1, text, "【") Else Exit Do End If LoopEnd Sub
-
WPS VBA插件简单使用教程（一） 目的：F4:K10000单元格内中【】内容为红色 一：下载安装WPS VBA插件https://wwgh.lanzn.com/iXNP32ovr6ne 二：输入VBA代码 完整代码如下： Sub OptimizedColorAllTextInBrackets() Dim targetRange As Range Dim cell As Range Dim text As String Dim startPos As Long, endPos As Long Dim arrBrackets() As Variant Dim i As Long ' 设置目标区域（F4:K10000），根据实际需求调整 Set targetRange = Range("F4:K10000") ' 关闭所有可能影响性能的功能 With Application .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False .EnableAnimations = False End With ' 遍历目标区域中的非空单元格（减少循环次数） For Each cell In targetRange.SpecialCells(xlCellTypeConstants) text = cell.Value If InStr(text, "【") > 0 Then ' 仅处理包含括号的单元格 cell.Font.Color = RGB(0, 0, 0) ' 重置整个单元格为黑色 ' 使用数组记录所有括号位置（减少多次InStr调用） ReDim arrBrackets(1 To Len(text) \ 2) startPos = InStr(text, "【") i = 0 Do While startPos > 0 endPos = InStr(startPos + 1, text, "】") If endPos > startPos Then i = i + 1 arrBrackets(i) = Array(startPos, endPos - startPos + 1) startPos = InStr(endPos + 1, text, "【") Else Exit Do End If Loop ' 批量设置颜色（减少Characters方法的重复调用） If i > 0 Then For startPos = 1 To i With cell.Characters(arrBrackets(startPos)(0), arrBrackets(startPos)(1)).Font .Color = RGB(255, 0, 0) End With Next startPos End If End If Next cell ' 恢复系统设置 With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic .EnableEvents = True .EnableAnimations = True End WithEnd Sub PS：延伸代码，单元格内出现0值时，单元格为空。 Sub OptimizedColorAllTextInBrackets() Dim targetRange As Range Dim cell As Range Dim text As String Dim startPos As Long, endPos As Long Dim arrBrackets() As Variant Dim i As Long ' 设置目标区域（F4:K10000） Set targetRange = Range("F4:K10000") ' 处理可能存在的空区域错误 On Error Resume Next Set targetRange = targetRange.SpecialCells(xlCellTypeConstants) On Error GoTo 0 If targetRange Is Nothing Then Exit Sub ' 关闭所有可能影响性能的功能 With Application .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False .EnableAnimations = False End With For Each cell In targetRange ' 处理0值单元格 If IsNumeric(cell.Value) Then If cell.Value = 0 Then cell.ClearContents GoTo ContinueLoop End If ElseIf cell.Value = "0" Then cell.ClearContents GoTo ContinueLoop End If text = cell.Value If InStr(text, "【") > 0 Then cell.Font.Color = RGB(0, 0, 0) ReDim arrBrackets(1 To Len(text) \ 2) startPos = InStr(text, "【") i = 0 Do While startPos > 0 endPos = InStr(startPos + 1, text, "】") If endPos > startPos Then i = i + 1 arrBrackets(i) = Array(startPos, endPos - startPos + 1) startPos = InStr(endPos + 1, text, "【") Else Exit Do End If Loop If i > 0 Then For startPos = 1 To i With cell.Characters(arrBrackets(startPos)(0), arrBrackets(startPos)(1)).Font .Color = RGB(255, 0, 0) End With Next startPos End If End IfContinueLoop: Next cell ' 恢复系统设置 With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic .EnableEvents = True .EnableAnimations = True End WithEnd Sub 三：输入自动运行代码 完整代码如下： ' 在对应工作表（如 Sheet1）的代码模块中添加以下代码Private Sub Worksheet_Change(ByVal Target As Range) Dim affectedRange As Range Dim cell As Range ' 设置监控区域（与宏中的目标区域一致） Set affectedRange = Me.Range("F4:K10000") ' 检查是否有单元格在监控区域内被修改 If Not Intersect(Target, affectedRange) Is Nothing Then ' 关闭事件和屏幕刷新防止递归和闪烁 Application.EnableEvents = False Application.ScreenUpdating = False ' 遍历所有被修改的单元格并调用处理函数 For Each cell In Intersect(Target, affectedRange) ProcessCell cell Next cell ' 恢复设置 Application.ScreenUpdating = True Application.EnableEvents = True End IfEnd Sub ' 独立函数：处理单个单元格的括号颜色Sub ProcessCell(ByVal cell As Range) Dim text As String Dim startPos As Long, endPos As Long Dim arrBrackets() As Variant Dim i As Long text = cell.Value cell.Font.Color = RGB(0, 0, 0) ' 重置颜色 ' 仅处理包含【的单元格 If InStr(text, "【") > 0 Then ReDim arrBrackets(1 To Len(text) \ 2) startPos = InStr(text, "【") i = 0 ' 记录所有括号位置 Do While startPos > 0 endPos = InStr(startPos + 1, text, "】") If endPos > startPos Then i = i + 1 arrBrackets(i) = Array(startPos, endPos - startPos + 1) startPos = InStr(endPos + 1, text, "【") Else Exit Do End If Loop ' 批量设置颜色 If i > 0 Then For startPos = 1 To i With cell.Characters(arrBrackets(startPos)(0), arrBrackets(startPos)(1)).Font .Color = RGB(255, 0, 0) End With Next startPos End If End IfEnd Sub 四：表格另存为带宏的表格
-
-
石库门的传奇：阿强的故事 第一章 青苔下的钥匙 我永远记得那个被蝉鸣撕裂的午后。石库门天井里的青砖泛着潮气，父亲生前栽的夹竹桃在穿堂风里簌簌作响。王阿婆的闲话像块烧红的炭，烫得我缩回扒拉砖缝的手指——她正用漏风的门牙向新搬来的租客比划："就西厢房那扇雕着饕餮纹的窗，四三年有个穿和服的东洋婆子吊死在上面，舌头垂得比晾衣绳还长..." 砖缝里的青苔突然簌簌颤动，半截发黑的牛皮绳从苔衣下滑出。当铜钥匙砸在砖面时，我瞥见钥匙柄上熟悉的梅花刻痕——和父亲临终前塞进我掌心的那把，像从同一个模子倒出来的双生子。 阁楼的霉味里混着父亲抽了二十年的老刀牌香烟味。横梁上那件灰布长衫的右袖裂着三寸长的口子，边缘焦黑卷曲，像是被什么灼烧过。我踮脚取下时，袖筒里突然滚出颗玻璃弹珠，在积灰的地板上画出道晶亮的弧线，直钻进墙角《申报》堆成的纸山里。 泛黄的报纸里裹着本硬皮日记，1943年的墨迹在梅雨季洇成团团鬼影："五月十七，虹口码头第三货仓。松井商社的货箱夹层渗出血水，巡捕房的人却说是腌渍海胆..."夹页里的照片飘落，穿藕荷色和服的女人侧身而立，她身后戴金丝眼镜的年轻男人正在锁门——那分明是楼下张裁缝梳着三七分油头的模样。 窗外的闷雷与座钟报时的铜音同时炸响。我盯着父亲总不许我碰的德国座钟，黄铜钥匙插进锁孔的瞬间，陈年机油味混着硝烟气息扑面而来。钟摆后弹出的暗格里，猩红和服碎片裹着的子弹头还带着焦痕，金线绣的半朵菊花在闪电里泛着冷光。 "小阿强。"枯叶般的声音贴着后颈爬上来，张裁缝的玳瑁眼镜映出我瞬间僵直的脊背，"这把戏你爹从五八年玩到七九年，到底还是传给了你。"他食指的银顶针擦过子弹头，在玻璃上刮出令人牙酸的声响。雨幕里忽然射进两道车灯，黑色丰田轿车的反光镜上，菊花家纹在积水倒影里扭曲成狰狞的鬼面。 第二章 血染的裁缝铺 张裁缝铺子的玻璃橱窗永远蒙着层水汽，就像他那只浑浊的右眼。我贴着潮湿的砖墙挪动时，听见里头传来剪刀开合的咔嗒声，像黄浦江夜班渡轮的汽笛般规律。七个旗袍假人的轮廓在磨砂玻璃上洇成鬼魅似的影子，第三个人偶的左手总是指向斜对面的永安当铺。 子夜时分，周璇的歌声突然断了。我摸到后窗裂缝处，看见张裁缝正用银顶针蘸着朱砂，在真丝绉缎上绣并蒂莲。绣绷旁的珐琅盒里泡着三枚带倒刺的缝衣针，在月光下泛着幽幽蓝光——那是我在父亲工具箱里见过的款式，他总说这是修钟表的专用针。 "出来吧小阿强，"剪刀尖在玻璃上划出刺耳的长音，"你爹当年蹲的也是这个位置。"他撩起左裤腿，狰狞的弹疤在疤痕间蜿蜒成地图模样，"四三年中秋，我背着中枪的老钟表匠翻过礼查饭店的后墙，他的血把苏州河都染红了半里地。" 账房先生的永安当铺藏着整个闸北最奇的物件。玻璃柜里泡着美人鱼标本的福尔马林瓶旁，1937年的月份牌女郎还在对路人巧笑嫣然。当我掏出当票时，他缺指的手突然攥住我的腕子："当年你爹塞给我这个，说要是哪天石库门屋檐下的铜铃响三长两短..." 怀表机芯在寂静中炸响《义勇军进行曲》的刹那，黄铜表盖内侧的刻痕突然清晰——那根本不是防御工事图，而是用摩斯密码标注的日军实验室坐标。账房先生往紫砂壶里添水的手抖得厉害，壶嘴竟对准了墙上月份牌的八月十五："知道为什么松井商社非要拆石库门？他们找的哪是黄金，是埋在承重墙里的...咳咳..." 突如其来的汽油味打断了低语。我们冲回天井时，火舌正舔舐着西厢房的雕花窗棂。在父亲常年擦拭的第八块地砖下，带弹孔的和服碎片突然自燃，在空中烧出诡异的绿色火焰。我跟着飘落的灰烬钻进地窖，发现那杆黄铜秤的刻度盘背面，父亲用钟表油写着一行小字："秤砣藏星火，可焚十里洋场。" 当地道尽头的铁盒发出齿轮转动的轻响时，我终于明白父亲为何总在清明烧纸船。染血的花名册里夹着半张《申报》，1943年5月18日的头条新闻下，有人用钢笔圈出油墨瑕疵："昨夜虹口码头爆炸案中，忠义救国军成员张耀祖身中七弹，遗体下落不明。"而泛黄的照片上，穿阴丹士林布旗袍的女子脖颈处，正系着我在阁楼发现的梅花钥匙。 第三章 黄浦江底的秘密 佐藤的鳄鱼皮鞋碾过碎砖时，我正躲在腌菜缸里。他公文包滑出的地图上，红圈标注着石库门与十六铺码头，还有五个墨迹未干的字："防疫给水部"。 "昭和二十年的东西，该物归原主了。"佐藤的中文带着冰碴，他抚摸着烧焦的窗棂，"我祖父的日记里写过，有个裁缝往他的茶里加了整整三个月砒霜。"他突然掀开墙角青砖，暗格里蜷缩着张裁缝的青布鞋，鞋尖浸着黑血。 账房先生的怀表在子时响起《义勇军进行曲》时，我正在地窖拆解那杆黄铜秤。秤砣裂开的瞬间，微型胶卷裹着蒲公英种子飘落——1943年的虹口地图上，红十字标记旁写着"芥子气储藏点"。 梅雨又至的那天，我站在十六铺码头看拖船搅碎江面的月光。父亲日记最后一页的密码终于破译，泛潮的纸页显出惊心动魄的一行："江底沉箱座标：东经121.30，北纬31.14，水位降至吴淞高程1.5米可见" 黑色丰田车的远光灯刺破雨幕时，我将子弹头按进江堤石缝。佐藤的怒吼混着汽笛声传来，而江水正漫过父亲用二十年光阴守护的座标。在血珠滴落江面的瞬间，我仿佛看见张裁缝在火光中举起剪刀，父亲的金怀表在浊浪里泛起微光。
