STR_Liang的博客

Function 文件类型csv另存为xlsx() '请记得先改一下路径，做好备份，最好不要另存为原路径 'ActiveWorkbook.SaveAs Filename:=Replace(ActiveWorkbook.Path, "新数据", "新数据-新") & "/" & Replace(ActiveWorkbook.name, "csv", "xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False .

Sub 数据透视表的相关操作VBA程式代码段() Rem PivotTables(1) 代表第一个数据透视表，这样就可以不用写名字了 Rem 分类汇总 For Each i In ActiveSheet.PivotTables(1).PivotFields i.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) '.

2020-12-16- 最近一直写Python，VBA写的都少了，一些知识点都不熟悉了再次写一遍，巩固一下，本次写程序过程中用到的 遗忘的知识点（主要是VBA数组和VBA字典的用法）1、数组 1.1 '定义一个常量数组 Dim arr As Variant ' 声明一个变量 arr = Array("one", "two", "three") '定义一个数组 长度为2 数组元素目前为 arr(0) = "one", arr(1) = "tw

转-http://club.excelhome.net/thread-818529-1-1.html类型说明如下：类型及记忆方法：!——单精度浮点数1个感叹号，所以是单精度。#——双精度浮点数二横二竖，所以是双精度。$——字符串型 外形像极了S，所以是String，文字型么&——长整型 外形像L的花体字，所以是Long，长整型么。@——货币型 这个好说，一般也这么用的。 @=Price么。%——整型 百分比符号，百来个整数，当然非...

Function 取汉字(txt, Optional L = 1) Set reg = CreateObject("VBScript.RegExp") pt = Choose(L, "\w", "[^a-zA-Z]", "\D", "[^a-z]", "[^A-Z]", "\W") With reg .Global = True .Pattern = pt 取汉字 = .Replace(txt, "") End WithEn.

VBA学习笔记--数组和单元格互相转换原文链接：https://www.cnblogs.com/Jacklovely/p/6606686.html说明（2017.3.23）：1. VBA的数组还是很难用的，其实就是非常难用！2. 要先定义一个数组，可以是空的，也可以里面写个数字作为数组长度。3. 如果是空数组，可以后面redim重新定义数组长度。如果不是空的，再用redim就会报错“数组维数已定义”！4. dim里面不能用变量，报错“只能用常数表达式”，里面只能用具体数字。5.

我要加全部框线，录制宏得到的代码（心态爆炸，加个框线需要这么多代码么？）：Sub 宏1()'' 宏1 宏' Range("C7:D9").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selectio...

之前被问到，Python 很强大，但是需要单独安装，而VBA是office自带的，那么两者结合的话，如何用Python调用VBA呢？代码如下：'''@Author: Liang@LastEditors: Liang@Date: 2020-06-30 14:27:25@LastEditTime: 2020-07-26 19:59:47@Email: str-liang@outlook.com@FilePath: /undefinedc:/Users/mayn/Downloads/te

Sub 针对所有工作表_取消所有行_所有列的隐藏项() Dim sht As Worksheet For Each sht In Worksheets sht.Activate Cells.EntireColumn.Hidden = False Cells.EntireRow.Hidden = False NextEnd Sub

对工作表的操作——worksheet 其中的"123" 是密码 下面同理Sub test_worksheet_key() ActiveSheet.Protect ("123") '加密 ActiveSheet.Unprotect ("123") '解密End Sub对工作簿的操作——workbookSub test_workbook_key() ActiveWorkbook.Protect ("123"), Structure:=True, Win...

Sub 拆分到工作表到工作簿() Dim wk As Workbook, pt$, k% Application.DisplayAlerts = False For Each sht In ActiveWorkbook.Sheets k = k + 1 Set wk = Workbooks.Add Workbooks(1).Sheets(k).Copy.

VBA 中循环 + 遍历 的写法Sub test_arr() 'VBA 中循环 + 遍历 的写法 arr = Array(1, 2, 3) For i = 0 To 5 Debug.Print (i) Next Debug.Print ("----------------我是分割线------------------") For Each s In arr Debug.Print (s) .

Sub VBA小程序_根据指定列关键词拆分工作表() Rem 可以无视关键词排序的问题，开始之前会去掉筛选状态，避免错误 Dim title As Range, split_rng As Range, title_sht_name As String, rng As Range, title_row As Long, split_rng_column As Long time_now = Timer() title_sht_name = ActiveSheet...

我这里是关键词是 "测试"，逻辑是：现实情况中，不方便/不允许使用On Error的情况下，我们可换一个思路，可以判断是不是Nothing1、先说第一种情况：遍历所有工作表，是否存在某一个关键词Sub 搜索确认() Dim sht As Worksheet, a For Each sht In Worksheets sht.Activate Set a = Cells.Find(What:="测试") 'Debug.Print()，可

源字符 含有多少个这样的字符 结果 HelloWorld O 0 HelloWorld o 2 HelloWorld l 3 Sub VBA小程序_获取单元格里面出现多少个字符() For i = 2 To 4 'Cells(i, 3).Value = UBound(Split(Cells(i, 1), Cells(i, 2))) 我是注释，也可以这样写~ Range("C" & i).V.

判断数据类型函数函数 功能 备注 TypeName() 判断变量类型 适用于不知道什么类型的情况 IsNumeric() 判断变量是否为数值 可能存在VBA自动类型转换的情况 IsDate() 判断变量是否为日期 无 IsNull() 判断变量是否包含任何有效数据 无 IsEmpty() 判断变量是否为空 无 IsArray() 判断变量是否为一个数组 无 IsError() 判断变量是

Sub VBA小程序_清除工作簿所有Sheet工作表的条件格式() Dim sht As Worksheet For Each sht In Worksheets sht.Activate sht.Cells.FormatConditions.Delete '清除整个Sheet的条件格式 NextEnd Sub

使用VBA（Workbooks.Open(Filename)命令）打开文件，出现这种外部链接的文件，不想让它弹出来，怎解？Sub test_open() Dim wb As Workbook Set wb = Workbooks.Open(Filename:="D:\每日例行\日报.xlsx", UpdateLinks:=0)End Sub这样就可以实现打开符合要求的文件，并且传入第二个参数，Updatelinks，取消是否更新链接提示信息，采用全部不更新的模式操作文件..

Sub VBA小程序_遍历所有工作表_复制粘贴为数值() Dim sht As Worksheet For Each sht In Worksheets sht.Activate sht.Cells.Copy sht.Cells.PasteSpecial Paste:=xlPasteValues Cells(1, 1).Select Next Application.CutCopyMode = FalseEn.

Sub VBA小程序_遍历所有工作表_取消隐藏所有行_列() Dim shp As Shape, sht As Worksheet Rem On Error Resume Next '忽略报错，防止有#N/A Rem 遍历所有工作表，取消隐藏行 + 列 For Each sht In Worksheets sht.Activate sht.Cells.EntireColumn.Hidden = False '取消隐藏所有行 .

VBA小程序--针对所有已经打开的Excel文件_格式调整_针对所有工作表_冻结首行_无视所在位置Function 格式调整_针对所有工作表_冻结首行_无视所在位置() Dim sht As Worksheet For Each sht In Worksheets sht.Activate With Cells .HorizontalAlignment = xlCenter .VerticalAlignm.

几经修改，终于算是自己满意的一个VBA程序1、考虑了Excel新建Sheet的命名规则2、考虑的xls 和 xlsx文件（office2007前后的版本）3、考虑的子程序会不会对使用者造成误导，所以全部更改为FunctionF、考虑到新建Excel的命名优化5、考虑到隐藏工作表可能会带来的影响，已经提前进行了预处理6、考虑到同事（使用者）的表格可能存在不规范的情况，合并工作表的时候充分考虑了UsedRange所可能带来的影响'合并文件夹内所有Excel文件（目前仅限于..

Sub str_test() Dim str As String, str1 As String str = "sd\sdsds\" str1 = InStrRev(str, "\") MsgBox (str1) '从右向左查找，返回值是9 str1 = InStr(str, "\") MsgBox (str1) '从左向右查找，返回值是3End Sub...

Public Function ChooseFolder() As String '定义并新建一个对话框对象 Dim dlgOpen As FileDialog Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker) '如果当前没有对话框显示，就让他弹出对话框 If dlgOpen.Show = -1 Then ChooseFolder = dlgOpen.SelectedItems(1) .

代码1：（Function）Public Function ChooseFolder() As String '定义并新建一个对话框对象 Dim dlgOpen As FileDialog Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker) '如果当前没有对话框显示，就让他弹出对话框 If dlgOpen.Show = -1 Then ChooseFolder = dlgOpen.Sel

PS：使用下面的代码时，请先根据自己所需要处理的文件夹，进行更改mypath的路径Sub VBA打开文件夹内所有Excel表格() Dim myPath$, myFile$, WB As Workbook '这个$ 是相当于定义字符串 myPath = "F:\" '把文件路径知定义给变量，这里请自行更改，记得最后要加一个反斜杠 myFile = Dir(myPath & "*.xls*") '依次找寻指定路径中的*.xls，或者xlsx文件 Do Wh.

Sub 针对选中区域_数字转文本() Dim cel As Range, rng As Range, i As Integer 'On Error Resume Next '忽略错误，继续执行下一条 i = MsgBox("请勿选中整列" & Chr(13) & Chr(13) & "继续执行请点击确定" & Chr(13) & Chr(13) & "否则请点击取消", vbYesNo) If i = 7 Then ...

Sub test() MsgBox (Rows("2:" & Rows.Count).SpecialCells(12).Row)End Sub

ActiveSheet.AutoFilterMode = False

Option Explicit '强制声明变量Sub 京东所需表格数据清洗程式_删除图片_取消合并_搜索删行() Dim r As Long, shp As Shape, sht As Worksheet On Error Resume Next '忽略报错，防止有#N/A Rem 遍历所有工作表 For Each sht In Worksheets Rem 清除图形对象 sht.Activate For Each.

ExcelHome - VBA代码宝简介及免费下载http://club.excelhome.net/thread-1440316-1-1.html个人真心推荐，获益匪浅。在此感谢~（非商业 / 人情相关）自带VBA代码库：《别怕Excel VBA其实很简单》《Excel VBA 经典代码应用大全》自己也可以去写，方便自己后期调用...

Sub VBA小程序_对于选中的单元格进行取消合并_选择空值向上填充() Dim a As Range Set a = Selection '定义变量为最初选择的区域，不忘初心 Selection.UnMerge '取消合并 Selection.SpecialCells(xlCellTypeBlanks).Select '选择空值 Selection.FormulaR1C1 = "=R[-1]C" '=上面的值 a.Copy '原则最开始的区域...

Sub name_err() On Error GoTo ERR_1 '异常陷阱，异常捕获 Worksheets("工作表目录").Activate '这里可以变更为自己需要的程序语句 Worksheets("工作表目录").Rows("1:" & Rows.Count).ClearContents Exit Sub '没有遇到异常，则退出子程序ERR_1: '如果执行错误，则新建工作表 Worksheets.Add.name = "工作表目录.

Sub name_err1() '因为异常捕获是子程序，所以不会影响主程序的报错机制，所以 "On Error GoTo 0" 加不加这句话都会正常报错,而不会跳转到子程序的异常陷阱之中... On Error GoTo ERR_1 '异常陷阱，异常捕获 Worksheets("工作表目录").Activate '这里可以变更为自己需要的程序语句 Exit Sub '没有遇到异常，则退出子程序，请勿携程End Sub，不然会报错："标签未定义"ERR_1: '.

如下：这是微信截图的样式，QQ截图，或者其他的截图软件，亦是同理，都会显示RGB颜色，不知道RGB，就去截一下图，一看便知Sub color_test() 'RGB格式（微信截图，QQ截图，以及其他的截图工具都会有RGB的颜色提示） Cells(1, 1).Interior.Color = RGB(255, 255, 0) '设置背景颜色为黄色 Cells(1, 1).Font.Color = RGB(255, 0, 0) '设置字体颜色为红色 'Colo.

需求：循环每一个工作表，在每一个工工作表的首行搜索“单号”，并将这两个字改为“订单号”Sub 在第一行搜索_单元格匹配_并将搜索结果更改() Dim sht As Worksheet Application.ScreenUpdating = False '禁止屏幕刷新--提升代码执行速度 Application.Calculation = xlCalculationManual '计算模式为手动--提升代码执行速度 On Error Resume Next

原文链接：http://club.excelhome.net/thread-1286472-1-1.html致敬，感恩，ExcelHome，在那里学到了很多主题：VBA-加快你的代码运行速度我们知道,用VBA实现同一个效果可能有多种不同的方法,写出一个最有效率的代码是大家都追求的,但是假如我水平有限,经验不足,实践不多,或者逻辑线路的设计不够简洁清爽,是不是就无法大幅提高代码速度?当然不是,如果你学会使用以下技巧,即便你的代码设计水平一般,也可以让它的运行大大加快.首先记住...

Sub 获取文件列表() Dim m As Long, myFile MsgBox ("使用前请先查看路径是否需要变更，另外文件列表会写入当前活动工作表的第一列,确认请按Enter按键，取消请按Ctrl + PauseBaeak") mypath = "F:\每月例行-利润核算\" '最后要加一个反斜杠，不然会认为是一个文件，而不是一个文件列表 嗯，应该是这样... myFile = Dir(mypath & "*.xls*") '可以使用通配符，输出.

在工作中，难免会遇到各种坑爹的队友，给你乱七八糟的表格。我现在需要将这种奇葩的各种格式的标题拎出来，看看到底都是谁的表格，如果都是同一个人的，那就对这个人的表格进行专项处理，因为其他人的表格还算格式整齐财务部已经在推行格式统一化，方便你我他。。。.Sub 数据清洗_寻找关键词_并将前面的工作表名字一起复制到新表_用于检查都是谁的表() Dim r_num As Long, i As Long i = 1 With Worksheets("合..

Sub 遍历所有工作表_删除所有图片() Dim shp As Shape, sht As Worksheet Rem On Error Resume Next '忽略报错，防止有#N/A Rem 遍历所有工作表 For Each sht In Worksheets sht.Activate Rem 清除图形对象 For Each shp In sht.Shapes shp.Delete .