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

作者: MrDcheng | 来源:发表于2019-10-23 16:20 被阅读0次

▲ 获取所在工作表名称

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

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

参数分解：

CELL("filename",$A$1)，获取该 excel 文件的磁盘全路径，例如：D:\工作文件\费用明细表.xlsx]Sheet1
LEN(CELL("filename", $A$ 1))，获取磁盘全路径长度，本例为 26
FIND("]",CELL("filename", $A$ 1))，在磁盘全路径中查找中括号第一次出现的位置，本例为 20

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

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

INDIRECT(ref_text, [a1])

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

参数说明：

Ref_text，必需。对包含 A1 样式及 R1C1 样式的引用、定义为引用的名称或对单元格的引用作为文本字符串的单元格的引用。如果 ref_text 不是有效的单元格引用, 则间接返回 #REF!；如果 ref_text 引用另一个工作簿（外部引用），则必须打开另一个工作簿。如果源工作簿未打开, 则间接返回 #REF!。注意：Excel Web App 中不支持外部引用；如果 ref_text 引用的单元格区域超出 1048576 的行限制或列限制 16384（XFD）, 则间接返回 #REF! 错误。此行为不同于早于 Microsoft Office Excel 2007 的 Excel 版本, 这将忽略超过的限制并返回值。
A1，可选。一个逻辑值，用于指定包含在单元格 ref_text 中的引用的类型。如果 a1 为 TRUE 或省略，ref_text 被解释为 A1-样式的引用；如果 a1 为 FALSE，则将 ref_text 解释为 R1C1 样式的引用。

使用案例：

可通过变量来构造表名，设 A3 值为 1，C3 值为 sheet，要返回名称 sheet1 表中 E3:E200 区域的引用：=INDIRECT(C3&A3"!E3:E200")；返回单元格：=INDIRECT(C3&A3"!B1")

▲ SUMIFS 函数

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

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

参数说明：

sum_range，求和区域
criteria_range1，条件区域 1
criteria1，条件 1
criteria_range2，条件区域 2，可选。更多条件区域以此类推
criteria2，条件 2，可选。更多条件以此类推

	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

使用案例：

单条件。计算广州地区的所有产品销量，在某单元格应用公式：=SUMIFS(F2:F9,D2:D9,"广州")，结果为 800
双条件。统计深圳地区的前全部办公用品销量，在某单元格应用公式：=SUMIFS(F2:F9,D2:D9,"深圳",C2:C9,"办公用品")，结果为 150
多条件。统计广州、深圳地区的水果销量，在某单元格应用公式：=SUM(SUMIFS(F2:F9,D2:D9,{"广州","深圳"},C2:C9,"水果"))，结果为 1400。使用注意：该案例公式由 SUM 和 SUMIFS 两个函数组成，其中 SUMIFS 函数用来分别统计广州和深圳的水果销量之和，SUM 函数用来把 SUMIFS 求出的分项之和加起来。SUMIFS 的多条件 {"广州","深圳"} 必须用数组。
多条件。统计广州、深圳地区的单价为15元、10元、126元的产品销量，在某单元格应用公式：=SUM(SUMIFS(F2:F9,D2:D9,{"广州","深圳"},E2:E9,{15;10;126}))，结果为 1400。使用注意：数值数组要用分号分隔，否则会出现错误。上例如果用逗号，将只统计满足 15 和 10 的条件，忽略 126，结果为 1300。
通配符。统计产品名两个字，地区含有州字，单价大于 100 元的产品销量，在某单元格应用公式：=SUM(SUMIFS(F2:F9,B2:B9,"??",D2:D9,"*州",E2:E9,">100"))，结果为 120

注意事项:

可在条件中使用通配符：问号（?）和星号（*），问号匹配任意单个字符，星号匹配任意一个或一串字符；果要查找 ? 和 *，需要加转义字符 ~
条件中使用文本条件、含有逻辑或数学符号的条件必须用双引号括起来。例如使用大于号：">50" 或 ">"&50。
SUMIFS 只对数值求和，忽略文本，如果选中的求和区域全为文本，则返回 0；如果既有文本又有数值，则只取数值求和。

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

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

▲ 判断内容是否为数字

ISNUMBER()

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

使用案例：

结合 IF 函数，可使用公式判断单元格值：=IF(ISNUMBER(A1),"是","否")
若要判定文本型数值，需要利用 VALUE() 函数对内容进行数值转换，如果转换成功说明确实为数值；如果出错则说明不是数值。上述公式改为：=IF(ISERROR(VALUE(A1)),"否","是")

▲ 统计不重复内容的数量

使用案例：

	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

=SUMPRODUCT(N(COUNTIF(A1:A11,A1:A11)=1))，得出没有重复的内容个数，结果为 5；
=SUMPRODUCT(1/COUNTIF(A1:A11,A1:A11))，把重复的内容计数一次，和无重复内容一起统计总数，结果为 8。

▲ 从字符串中查找字符串

SEARCHB(find_text,within_text,start_num)

参数说明：

find_text，要查找的文本。可以直接输入文本、数字或单元格引用；也可以使用通配符：问号（?）和星号（*），问号匹配任意单个字符，星号匹配任意一个或一串字符；果要查找 ? 和 *，需要加转义字符 ~
within_text，查找目标，对其执行查找。可以直接输入文本、数字或单元格引用。
start_num，要开始查找的位置。如果省略该参数，则默认值为1；如果该参数小于 0 或大于文本长度，都将会返回 #VALUE! 错误值。

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

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

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

使用案例：

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

在 B 列使用公式：=IF(COUNT(SEARCHB("APPLE",A1))=1,"是苹果","不是苹果") 判断 A 列内容（不区分大小写）。

▲ 从中文字符串提取数值

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

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

参数说明:

text，必需。需要替换其中字符的文本，或对含有文本（需要替换其中字符）的单元格的引用。
old_text，必需。需要替换的文本。
new_text，必需。用于替换 old_text 的文本。
instance_num，可选。指定要用 new_text 替换 old_text 的事件。如果指定了 instance_num，则只有满足要求的old_text 被替换。否则，文本中出现的所有 old_text 都会更改为 new_text。

▲ 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。

细节说明：

Application.ScreenUpdating = False，关闭视图跟随
t = Timer，获取当前时间（非本案例必须）
UBound(arr)，返回引用区域的上限值

▲ 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

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

▲ 获取所在工作表名称

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

▲ SUMIFS 函数

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

▲ 判断内容是否为数字

▲ 统计不重复内容的数量

▲ 从字符串中查找字符串

▲ 从中文字符串提取数值

▲ VBA 调整行高

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

▲ VBA 判断文件是否打开

▲ VBA 取得行数和列数

▲ VBA 在工作表插入新行

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

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

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

相关文章

网友评论

延伸阅读

深度阅读

栏目导航

热点阅读