Excel 公式及 VBA 使用笔记（不定时补充）

2019-10-23  本文已影响0人  MrDcheng

▲ 获取所在工作表名称

RIGHTB(CELL("filename",$A$1),LEN(CELL("filename",$A$1))-FIND("]",CELL("filename",$A$1)))

释义：磁盘全路径长度减去第一个中括号出现位置的长度得到表名长度，再从磁盘全路径右取该长度即得到表名。

参数分解：

注意事项：单元格 $A$1 不固定，只要是表内单元格即可。

▲ 通过字符串或变量引用单元格和区域

INDIRECT(ref_text, [a1])

释义：返回由文本字符串指定的引用，可以是单元格，也可以是区域。

参数说明：

使用案例：

▲ SUMIFS 函数

SUMIFS(sum_range, criteria_range1, criteria1, [criteria_range2, criteria2], ...)

释义：统计指定区域在满足单个或多个条件时的和。

参数说明：

A B C D E F
1 编号 产品名称 分类 地区 价格 销量
2 20190001 苹果 水果 广州 15 700
3 20190002 显示器 办公用品 深圳 700 50
4 20190003 键盘 办公用品 杭州 60 50
5 20190004 榴莲 水果 广州 126 100
6 20190005 手机 电子产品 杭州 1500 20
7 20190006 芒果 水果 深圳 10 600
8 20190007 白纸 办公用品 深圳 80 100
9 20190008 橘子 水果 杭州 10 550

使用案例：

注意事项:

▲ 将数值转换成文本字符串

可使用：A1&"" 或 TEXT(A1,"0")

▲ 判断内容是否为数字

ISNUMBER()

释义：如果目标单元格为数值则返回 TRUE，否则 FALSE。

使用案例：

▲ 统计不重复内容的数量

使用案例：

A B C
1 苹果 1 1
2 梨 2 1
3 芒果 3 1
4 苹果 1
5 山竹 4 1
6 榴莲 5 1
7 莲雾 6 1
8 山竹 4
9 火龙果 7 1
10 荔枝 8 1
11 荔枝 8

▲ 从字符串中查找字符串

SEARCHB(find_text,within_text,start_num)

参数说明：

FIND 函数、FINDB 函数、SEARCH 函数、SEARCHB 函数之间的功能相似，区别如下：

单位 是否区分大小写 能否使用通配符
FIND 以字符为单位 是 不能
FINDB 以字节为单位 是 不能
SEARCH 以字符为单位 否 能
SEARCHB 以字节为单位 否 能

注意事项：如果找不到指定的文本，将返回 #VALUE!

使用案例：

A B
1 APPLE2019001 是苹果
2 apple2019005 是苹果
3 other2019001 不是苹果
4 tools2019003 不是苹果

▲ 从中文字符串提取数值

substitute(text,old_text,new_text,[instance_num])

释义：在文本字符串中用 new_text 替换 old_text。 如果需要在某一文本字符串中替换指定的文本，请使用函数 SUBSTITUTE；如果需要在某一文本字符串中替换特定位置处的任意文本，请使用函数 REPLACE。

参数说明:

▲ VBA 调整行高

Sub Macro1()
    Dim arr, rng As Range, i&
    Application.ScreenUpdating = False
    t = Timer
    arr = Range("A1").CurrentRegion
    For i = 1 To UBound(arr)
        If Rows(i).RowHeight > 10 Then
            If rng Is Nothing Then 
                Set rng = Cells(i, 1) 
            Else 
                Set rng = Union(rng, Cells(i, 1))
        End If
    Next
    If Not rng Is Nothing Then
        rng.EntireRow.RowHeight = 10
    Application.ScreenUpdating = True
    MsgBox Timer - t
End Sub

释义：遍历 A 列中不为空的行，将行高设置为 10。

细节说明：

▲ VBA 实现将指定内容跨文件复制

使用案例：

将 workBook1.xlsm 所有工作表的指定区域复制到 workBook2.xlsx，更新标题，工作表名称不变，并设置打印信息。

Sub CopyRangeAcrossFile()
    '关闭视图跟随
    Application.ScreenUpdating = False
    Dim desSheet, desTitle, bottomTitle, sheet As Worksheet
    '最大行数
    Dim maxLineNum
    Set desSheet = Workbooks.Open(ThisWorkbook.Path & "\" & "workBook2.xlsx")
    For Each sheet In Sheets
        '获取第一列的长度（包含无内容空行）
        maxLineNum = WorksheetFunction.CountA(sheet.Columns(1))
        '激活要复制的工作表（重要，否则无法复制）
        sheet.Activate
        '指定复制区域
        sheet.Range("A1:M" & Trim(Str(maxLineNum))).Select
        Selection.Copy
        '激活要粘贴的工作表（注意：workBook2.xlsx 至少有一个空表，否则无法粘贴）
        desSheet.Sheets(1).Activate
        '新建工作表，名称与原工作表相同
        desSheet.Worksheets.Add().Name = sheet.Name
        '选择新工作表中要粘贴的区域
        desSheet.Sheets(sheet.Name).Range("A1").Select
        '不运算粘贴、不跳过空格、不转置
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        '更新新工作表标题
        desSheet.Sheets(sheet.Name).Range("A1").Value = "new" & sheet.Range("A1").Value 
        '设置新工作表标题字体
        desSheet.Sheets(sheet.Name).Range("A1").Font.Size = 14
        '设置新工作表行高（全部行）
        desSheet.Sheets(sheet.Name).Cells.RowHeight = 28
        '独立设置新工作表标题行高
        desSheet.Sheets(sheet.Name).Rows(1).RowHeight = 50
        '设置新工作表 A 列列宽
        desSheet.Sheets(sheet.Name).Columns("A").ColumnWidth = 3
        '设置新工作表打印信息
        With desSheet.Sheets(sheet.Name).PageSetup
            '设置页面的方向。xlPortrait 纵向；xlLandscape 横向
            .Orientation = xlLandscape
            '左右页边距
            .LeftMargin = Application.InchesToPoints(1)
            .RightMargin = Application.InchesToPoints(1)
            '设置打印区域
            .PrintArea = "A1:L" & Trim(Str(maxLineNum + 4))
        End With
    Next
End Sub

▲ VBA 判断文件是否打开

Function IsWbOpen(strName As String) As Boolean
    Dim w As Workbook
    For Each w In Application.Workbooks
        If w.Name = strName Then 
            IsWbOpen = True: Exit Function
        End If
    Next
    IsWbOpen = False
End Function

▲ VBA 取得行数和列数

1、方式一：

    ActiveSheet.UsedRange.Rows.Count  
    ActiveSheet.UsedRange.Columns.Count

注意事项：该方式结果可能会大于现有数量，原因曾经删除过行（或列），而且是非整行或整列删除。该语句仍返回未删除前的值，这部分行虽然已经删除，但是也记录在内。

2、方式二：

ActiveSheet.Range("A65535").End(xlUp).Row
ActiveSheet.Range("IV1").End(xlToLeft).Column

或

ActiveSheet.[A65536].End(xlUp).Row
ActiveSheet.[IV1].End(xlToLeft).Column

注意事项：只能计算出一列（行）的最后一个单元格所在的行（列）数。本例返回 A 列最后一个单元格所占的行数。

3、方式三：

Application.CountA(ActiveSheet.Range("A:A"))
Application.CountA(ActiveSheet.Range("1:1"))

或

Application.CountA(ActiveSheet.Columns(1))
Application.CountA(ActiveSheet.Columns(1))

注意事项：只能统计一列（行）的实际使用情况，得到的不一定是最后一行（列）的位置。方式二的数值比此方式大时，说明在 A 列的数据间有空白未填写的单元格。

▲ VBA 在工作表插入新行

使用案例：

Sub InsertRow()
    Dim currentSheet As Worksheet
    '激活当前工作表
    Set currentSheet = ActiveSheet
    '限制不能插入行的工作表
    If currentSheet.Name = "Sheet1" Or currentSheet.Name = "Sheet2" Then
        MsgBox "该表格不允许添加行！"
        Exit Sub
    End If
    '获取当前激活工作表的最大行数（）
    Dim maxLineNum
    '对话框确定插入行数
    Dim insertNum As Integer
    insertNum = InputBox("输入要插入的行数！", "输入行数", "")
    '解锁（必须要解锁工作表才能够增加行）
    currentSheet.Unprotect Password:=123456
    '循环变量
    Dim index As Integer
    '循环，在当前激活工作表末尾插入新行
    For index = 1 To insertNum
        '获取当前激活工作表有效行数上限（不含无内容空行）
        maxLineNum = WorksheetFunction.CountA(currentSheet.Columns(1))
        currentSheet.Rows(maxLineNum).Insert shift:=xlShiftDown
    Next
    '执行完毕后恢复加锁状态
    currentSheet.Protect Password:=123456
End Sub

▲ VBA 删除所有工作表的空行

使用案例：

清除工作表中所有无内容空行：

Sub 删除空行()
    '关闭视图跟随
    Application.ScreenUpdating = False
    '定义变量
    Dim sheet As Worksheet
    '最大行数
    Dim maxLineNum
    '循环变量
    Dim index As Integer
    '内容为空的最小行号
    Dim minLineNum As Integer: minLineNum = 0
    '遍历所有工作表
    For Each sheet In Sheets
        '清零
        minLineNum = 0
        '激活要工作表
        sheet.Activate
        '解锁（必须要解锁工作表才能够删除行）
        sheet.Unprotect Password:=123456
        '获取最大行数
        maxLineNum = sheet.[A65536].End(xlUp).Row
        '逆序删除（删除行或列均需要逆序删除）
        For index = maxLineNum To 3 Step -1
            'B 列内容为空则判为无内容空行
            If sheet.Range("B" & Trim(Str(index))).Value = "" Then
                minLineNum = index
            End If
        Next
        If minLineNum > 0 Then
            sheet.Range(sheet.Rows(minLineNum), sheet.Rows(maxLineNum - 1)).Delete
        End If
        '执行完毕后恢复加锁状态
        sheet.Protect Password:=123456
    Next
End Sub

▲ VBA 使用 ReDim 实现二维动态数组

使用案例：

Sub DynamicArray()
    Dim cellType, rowIndex, sheet As Worksheet
    '定义数组
    Dim dataArray()
    '改变大小（必须要在使用前定好基础大小，初始为 2 行 1 列）
    ReDim dataArray(1 To 2, 1 To 1)
    '遍历所有工作表
    For Each sheet In Sheets
        '遍历行
        For rowIndex = 1 To 65535
            '获取 O 列单元格的值
            cellType = sheet.Range("O" & Trim(Str(rowIndex))).Value
            '遇到内容为空的行意味着到达结尾，退出循环
            If cellType = "" Then
                Exit For
            End If
            '根据内容分类存入数组
            If cellType = "苹果" Then
                '获取当前数组的列数上限所在位置，存入
                dataArray(1, UBound(dataArray, 2)) = cellName
                '改变大小，本列增加 1 个存储位置
                ReDim Preserve dataArray(1 To 11, 1 To UBound(dataArray, 2) + 1)
            ElseIf cellType = "荔枝" Then
                dataArray(2, UBound(dataArray, 2)) = cellName
                ReDim Preserve dataArray(1 To 11, 1 To UBound(dataArray, 2) + 1)
            End If
        Next
    Next
End Sub

▲ VBA 筛选二维数组重复元素

使用案例：

以二维数组为例：

Sub RemovingDuplication()
    '临时变量
    Dim indexRow, indexA, indexB As Integer
    '无重复元素动态一维数组
    Dim resultTempArray()
    ReDim resultTempArray(1 To 1)
    '筛选中间元素数组
    Dim tempArray()
    Dim tempSplit() As String
    Dim Temp As String
    '遍历二维数组每行
    For indexRow = 1 To 2
        '取第 n 行
        tempArray = Application.index(dataArray, indexRow, 0)
        '重复元素用 @ 替代
        For indexA = 1 To UBound(tempArray)
            For indexB = indexA + 1 To UBound(tempArray)
                If tempArray(indexA) = tempArray(indexB) Then tempArray(indexB) = "@"
            Next
        Next
        '分隔 tempArray，消除 @ 标记，用空白字符串代替，获得无重复元素字符串
        Temp = Replace(Join(tempArray, ","), "@", "")
        '将无重复元素字符串重新按逗号分隔
        tempSplit = Split(Temp, ",")

        For indexA = LBound(tempSplit) To UBound(tempSplit)
            '将不为空字符串的元素存入动态一维数组
            If tempSplit(indexA) <> "" Then
                resultTempArray(UBound(resultTempArray)) = tempSplit(indexA)
                ReDim Preserve resultTempArray(1 To UBound(resultTempArray) + 1)
            End If
        Next
        '清空，构建结果字符串，格式为：（序号）元素名称，间隔为空格
        Temp = ""
        For indexA = 1 To UBound(resultTempArray) - 1
            Temp = Temp + "(" + Trim(Str(indexA)) + ")" + resultTempArray(indexA)
            If indexA <> UBound(resultTempArray) - 1 Then
                Temp = Temp + " "
            End If
        Next
        '写入结果
        With Worksheets("样品数据")
            '根据下标来依次填写结果到单元格，本例共两个类别
            .Range("类别" & Trim(Str(indexRow))).Value = UBound(resultTempArray) - 1
            .Range("详细" & Trim(Str(indexRow))).Value = Temp
        End With
        '每次统计下个类别前都清空
        ReDim resultTempArray(1 To 1)
    Next
End Sub
上一篇下一篇

猜你喜欢

热点阅读