EXCEL自学之路第一节

---

1.test01 excel生成目录
2.test02 打开全部隐藏工作表
3.test03 多个工作表汇总到一个工作表
4.test04 隔m列（行）插入n列空白列（行）
5.test05 合并工作簿
6.test06 更改工作表名
7.test07 解除excel结构限制
8.test08 解除工作表保护
9.test09 聚焦显示
10.test10 破解两位数及简单三位数密码
11.test11 批量修改文件名
12.test12 取消所有行列的隐藏
13.test13 列转行转置
14.test14 复制每一行为多行
15.test15 批量取消隐藏并删除隐藏工作表
16.test16 其它功能函数

---

前言

对于需要经常处理数据的同学们和企业中经常需要处理报表的同事来说，公式和VBA可以更快速有效的进行分析。

---

提示：以下是本篇文章正文内容

一、EXCEL函数和VBA？

EXCEL是常见的处理数据的一种工具，其中函数公式和VBA是为了解决批量数据分析任务而创建的。

二、使用方法

1.test01 excel生成目录

代码如下（示例）：

方法一
定义公式名称
单击A1单元格，切换到公式选项定义名称，引用位置处
=INDEX(GET.WORKBOOK(1),ROW(A1))&T(NOW())
B1单元格内输入
=HYPERLINK("#'"&INDEX(mulu,ROW())&"'!A1",MID(INDEX(mulu,ROW()),FIND("]",INDEX(mulu,ROW()),1)+1,100))
比较
=IFERROR(HYPERLINK(catalog&"!A1",MID(catalog,FIND("]",catalog)+1,99)),"")

方法二
Sub mulu()
On Error GoTo Tuichu
Dim i As Integer
Dim ShtCount As Integer
Dim SelectionCell As Range
ShtCount = Worksheets.Count
If ShtCount = 0 Or ShtCount = 1 Then Exit Sub
Application.ScreenUpdating = False
For i = 1 To ShtCount
If Sheets(i).Name = "目录" Then
Sheets("目录").Move Before:=Sheets(1)
End If
Next i
If Sheets(1).Name <> "目录" Then
ShtCount = ShtCount + 1
Sheets(1).Select
Sheets.Add
Sheets(1).Name = "目录"
End If
Sheets("目录").Select
Columns("B:B").Delete Shift:=xlToLeft
Application.StatusBar = "正在生成目录…………请等待！"
For i = 2 To ShtCount
ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("目录").Cells(i, 2), Address:="", SubAddress:= _
Sheets(i).Name & "!R1C1", TextToDisplay:=Sheets(i).Name
Next
Sheets("目录").Select
Columns("B:B").AutoFit
Cells(1, 2) = "目录"
Set SelectionCell = Worksheets("目录").Range("B1")
With SelectionCell
.HorizontalAlignment = xlDistributed
.VerticalAlignment = xlCenter
.AddIndent = True
.Font.Bold = True
.Interior.ColorIndex = 34
End With
Application.StatusBar = False
Application.ScreenUpdating = True
Tuichu:
End Sub 

方法三
建立目录和索引
Sub name_err()
    On Error GoTo ERR_1 '异常陷阱，异常捕获
    Worksheets("工作表目录").Activate   '这里可以变更为自己需要的程序语句
    Worksheets("工作表目录").Rows("1:" & Rows.Count).ClearContents
    Exit Sub    '没有遇到异常，则退出子程序
ERR_1:  '如果执行错误，则新建工作表
    Worksheets.Add.name = "工作表目录"  '这里可以变更为自己需要的程序语句
End Sub
Sub 工作簿中所有工作表建立目录()
    '为工作簿中所有工作表建立目录!
    Dim wt As Worksheet, sht As Worksheet, irow As Integer
    Call name_err
    'On Error GoTo 0    因为异常捕获是子程序，所以不会影响主程序的报错机制，这句话都会正常报错,而不会跳转到子程序的异常陷阱之中...
    With Worksheets("工作表目录")
    For Each sht In Worksheets
        irow = irow + 1      '行号加1，默认值为0
        .Cells(irow, 1).Value = irow '写入序号
        '写入工作表名，并建立超链接
        .Hyperlinks.Add Anchor:=.Cells(irow, 2), Address:="", SubAddress:="'" & sht.name & "'!A1", TextToDisplay:=sht.name
    Next
    End With
End Sub

2.test02 打开全部隐藏工作表

代码如下（示例）：

方法一
Sub 打开全部隐藏工作表()
Dim i As Integer
For i = 1 To Sheets.Count
    Sheets(i).Visible = True
Next i
End Sub

方法二
Sub 批量取消隐藏工作表()
Dim sht As Worksheet
For Each sht In Worksheets
sht.Visible = xlSheetVisible
Next
End Sub

3.test03 多个工作表汇总到一个工作表

代码如下（示例）：

方法一
Sub 工作表合并()
For Each st In Worksheets
If st.Name <> ActiveSheet.Name Then st.UsedRange.Offset(1, 0).Copy [a65536].End(xlUp).Offset(1, 0)
Next
End Sub

Sub 合并所有工作表_在所有行标注工作表名字_无视空行空列_考虑到不规范的多一点的行和列()
    Dim row_num As Long, column_num As Long, row_num_temp As Long, column_num_temp As Long, row_num_merge As Long, column_num_merge As Long, i As Long, arr() As Long
    Worksheets.Add.Name = "合并表"
    Sheets("合并表").Move before:=Sheets(1)
    For i = 2 To Worksheets.Count
        Worksheets(i).Activate
        'UsedRange.row，代表使用的第一个行数，在有空行的时候体现，同理，UsedRange.column，代表使用的第一个列数，在有空列的时候体现
        '那么使用第一行 + 已使用的行数，这样可以规避顶部/左侧有空行，导致获取已使用行号的数据不符合预期（老赵，如果你看到这里不懂，就自己拆开代码，加上空行空列体会一下）
        row_num = Worksheets(i).UsedRange.Row + Worksheets(i).UsedRange.Rows.Count - 1
        column_num = Worksheets(i).UsedRange.Column + Worksheets(i).UsedRange.Columns.Count - 1
        '如果格式很不规范，那么获取的UsedRange.rows.count就可能是整个表格的行数，所以要规避这种情况，如果相同，就让他减1
        If row_num = Worksheets(i).Rows.Count Then row_num = row_num - 1
        If column_num = Worksheets(i).Columns.Count Then column_num = column_num - 1
        
        '相当于遍历所有的列，都按ctrl + ↑，取数组的最大值
        ReDim arr(1 To column_num)
        For j = LBound(arr) To UBound(arr)
            row_num_temp = Worksheets(i).Cells(row_num + 1, j).End(xlUp).Row
            arr(j) = row_num_temp
        Next
        Debug.Print (Application.WorksheetFunction.Max(arr))
        row_num_temp = Application.WorksheetFunction.Max(arr) '赋予最大值，确定最大的有数据的行数
        
        '相当于遍历所有的行，都按ctrl + ←，取数组的最大值
        'Erase arr 清空数组，但是也可以不用，直接用ReDim也可以，如果要保留数组内容，需要加一个preserve
        ReDim arr(1 To row_num_temp)
        For j = LBound(arr) To UBound(arr)
            column_num_temp = Worksheets(i).Cells(j, column_num + 1).End(xlToLeft).Column
            arr(j) = column_num_temp
        Next
        Debug.Print (Application.WorksheetFunction.Max(arr))
        column_num_temp = Application.WorksheetFunction.Max(arr) '赋予最大值，确定最大的有数据的列数
        
        Worksheets(i).Range(Cells(1, 1), Cells(row_num_temp, column_num_temp)).Select
        Selection.Copy Sheets("合并表").Cells(row_num_merge + 1, 2)
        Worksheets("合并表").Cells(row_num_merge + 1, 1) = Worksheets(i).Name
        row_num_merge = Sheets("合并表").UsedRange.Rows.Count
    Next
    '将首行标题转为所有行（选择空值，=上面的数据）
    Worksheets("合并表").Activate
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Application.CutCopyMode = False
    Selection.FormulaR1C1 = "=R[-1]C"
    Columns("A:A").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
End Sub

4.test04 隔m列（行）插入n列空白列（行）

Sub 在不同的列左侧插入指定数量的空白列()

    Dim m, n, i As Integer    

    For n = 5 To 1 Step -1

        Sheets("Sheet1").Columns(n).Select

        m = Sheets("Sheet2").Cells(1, n).Value

        For i = 1 To m Step 1

            Selection.Insert Shift:=xlToRight

        Next i

    Next n

End Sub


注释：
Sub 在不同的列左侧插入指定数量的空白列()

    Dim m, n, i As Integer    

    For n = 5 To 1 Step -1'在sheet1工作表中，假设A列共有5列，要在每列的左侧插入第2行对应数字的空白列数，记住，是在左侧插入空白列，不是在右侧插入空白列

        Sheets("Sheet1").Columns(n).Select '选中sheet1工作表中的第n列

        m = Sheets("Sheet2").Cells(1, n).Value'提前把sheet1工作表中第2行的数字放到sheet2工作表第一行的前5个单元格中，这一步是必要的，然后取出sheet2工作表第1行的第m个单元格中的数字，赋给变量n

        For i = 1 To m Step 1 '利用for...next 循环在sheet1表中第m列左侧插入n个空白列

            Selection.Insert Shift:=xlToRight '单纯这一句的话，只能在第m列左侧插入一个空白列

        Next i

    Next n

End Sub

Sub 在不同的行上面插入指定数量的空白行()

    Dim m, n, i As Integer

    For m = 30 To 1 Step -2

        Sheets("Sheet1").Rows(m & ":" & m).Select

        n = Sheets("Sheet2").Cells(m, 1).Value

        For i = 1 To 1 Step 1

            Selection.Insert Shift:=xlDown

        Next i

    Next m

End Sub

注释：
Sub 在不同的行上面插入指定数量的空白行()

    Dim m, n, i As Integer

    For m = 7 To 1 Step -1 '在sheet1工作表中，假设A列共有7行，要在每行的上面插入B列对应数字的行数，记住，是在上面插入空白行，不是在下面插入空白行

        Sheets("Sheet1").Rows(m & ":" & m).Select'选中sheet1工作表中的第m行

        n = Sheets("Sheet2").Cells(m, 1).Value'提前把sheet1工作表中B列的数字放到sheet2工作表A列的前7个单元格中，这一步是必要的，然后取出sheet2工作表A列第m个单元格中的数字，赋给变量n

        For i = 1 To n Step 1'利用for...next 循环在sheet1表中第m行上面插入n个空白行

            Selection.Insert Shift:=xlDown'单纯这一句的话，只能在第m行上面插入一个空白行

        Next i

    Next m

End Sub

5.test05 合并工作簿

Sub 合并工作薄()

Dim FileOpen

Dim X As Integer

Application.ScreenUpdating = False

FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel文件(.xlsx),.xlsx", MultiSelect:=True, Title:="合并工作薄")

X = 1

While X <= UBound(FileOpen)

Workbooks.Open Filename:=FileOpen(X)

Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

X = X + 1

Wend

ExitHandler:

Application.ScreenUpdating = True

Exit Sub

errhadler:

MsgBox Err.Description

End Sub

6.test06 更改工作表名

Sub 改工作表名test1()
Application.ScreenUpdating = False
For t = 1 To Sheets.Count
    If Sheets(t).Visible = True Then Sheets(t).Name = Sheets(t).Range("A1").Value
Next
Application.ScreenUpdating = True
End Sub

7.test07 解除excel结构限制

Private Sub VBAPassword()

    '你要解保护的Excel文件路径
    Filename = Application.GetOpenFilename("Excel文件（*.xlsx & *.xla & *.xlt）,*.xlsx;*.xla;*.xlt", , "VBA破解")
    
    If Dir(Filename) = "" Then
    MsgBox "没找到相关文件,清重新设置。"
    Exit Sub
    Else
    FileCopy Filename, Filename & ".bak" '备份文件。
    End If
    
    Dim GetData As String * 5
    Open Filename For Binary As #1
    Dim CMGs As Long
    Dim DPBo As Long
    For i = 1 To LOF(1)
    Get #1, i, GetData
    If GetData = "CMG=""" Then CMGs = i
    If GetData = "[Host" Then DPBo = i - 2: Exit For
    Next
    
    If CMGs = 0 Then
    MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"
    Exit Sub
    End If
    
    Dim St As String * 2
    Dim s20 As String * 1
    
    '取得一个0D0A十六进制字串
    Get #1, CMGs - 2, St
    
    '取得一个20十六制字串
    Get #1, DPBo + 16, s20
    
    '替换加密部份机码
    For i = CMGs To DPBo Step 2
    Put #1, i, St
    Next
    
    '加入不配对符号
    If (DPBo - CMGs) Mod 2 <> 0 Then
    Put #1, DPBo + 1, s20
    End If
    MsgBox "文件解密成功......", 32, "提示"
    
    Close #1
    
End Sub

8.test08 解除工作表保护

Public Sub AllInternalPasswords()
' Breaks worksheet and workbook structure passwords. Bob McCormick
' probably originator of base code algorithm modified for coverage
' of workbook structure / windows passwords and for multiple passwords
'
' Norman Harker and JE McGimpsey 27-Dec-2002 (Version 1.1)
' Modified 2003-Apr-04 by JEM: All msgs to constants, and
' eliminate one Exit Sub (Version 1.1.1)
' Reveals hashed passwords NOT original passwords
Const DBLSPACE As String = vbNewLine & vbNewLine
Const AUTHORS As String = DBLSPACE & vbNewLine & _
"Adapted from Bob McCormick base code by" & _
"Norman Harker and JE McGimpsey"
Const HEADER As String = "AllInternalPasswords User Message"
Const VERSION As String = DBLSPACE & "Version 1.1.1 2003-Apr-04"
Const REPBACK As String = DBLSPACE & "Please report failure " & _
"to the microsoft.public.excel.programming newsgroup."
Const ALLCLEAR As String = DBLSPACE & "The workbook should " & _
"now be free of all password protection, so make sure you:" & _
DBLSPACE & "SAVE IT NOW!" & DBLSPACE & "and also" & _
DBLSPACE & "BACKUP!, BACKUP!!, BACKUP!!!" & _
DBLSPACE & "Also, remember that the password was " & _
"put there for a reason. Don't stuff up crucial formulas " & _
"or data." & DBLSPACE & "Access and use of some data " & _
"may be an offense. If in doubt, don't."
Const MSGNOPWORDS1 As String = "There were no passwords on " & _
"sheets, or workbook structure or windows." & AUTHORS & VERSION
Const MSGNOPWORDS2 As String = "There was no protection to " & _
"workbook structure or windows." & DBLSPACE & _
"Proceeding to unprotect sheets." & AUTHORS & VERSION
Const MSGTAKETIME As String = "After pressing OK button this " & _
"will take some time." & DBLSPACE & "Amount of time " & _
"depends on how many different passwords, the " & _
"passwords, and your computer's specification." & DBLSPACE & _
"Just be patient! Make me a coffee!" & AUTHORS & VERSION
Const MSGPWORDFOUND1 As String = "You had a Worksheet " & _
"Structure or Windows Password set." & DBLSPACE & _
"The password found was: " & DBLSPACE & "$$" & DBLSPACE & _
"Note it down for potential future use in other workbooks by " & _
"the same person who set this password." & DBLSPACE & _
"Now to check and clear other passwords." & AUTHORS & VERSION
Const MSGPWORDFOUND2 As String = "You had a Worksheet " & _
"password set." & DBLSPACE & "The password found was: " & _
DBLSPACE & "$$" & DBLSPACE & "Note it down for potential " & _
"future use in other workbooks by same person who " & _
"set this password." & DBLSPACE & "Now to check and clear " & _
"other passwords." & AUTHORS & VERSION
Const MSGONLYONE As String = "Only structure / windows " & _
"protected with the password that was just found." & _
ALLCLEAR & AUTHORS & VERSION & REPBACK
Dim w1 As Worksheet, w2 As Worksheet
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer
Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer
Dim PWord1 As String
Dim ShTag As Boolean, WinTag As Boolean
Application.ScreenUpdating = False
With ActiveWorkbook
WinTag = .ProtectStructure Or .ProtectWindows
End With
ShTag = False
For Each w1 In Worksheets
ShTag = ShTag Or w1.ProtectContents
Next w1
If Not ShTag And Not WinTag Then
MsgBox MSGNOPWORDS1, vbInformation, HEADER
Exit Sub
End If
MsgBox MSGTAKETIME, vbInformation, HEADER
If Not WinTag Then
MsgBox MSGNOPWORDS2, vbInformation, HEADER
Else
On Error Resume Next
Do 'dummy do loop
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
With ActiveWorkbook
.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If .ProtectStructure = False And _
.ProtectWindows = False Then
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
MsgBox Application.Substitute(MSGPWORDFOUND1, _
"$$", PWord1), vbInformation, HEADER
Exit Do 'Bypass all for...nexts
End If
End With
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True
On Error GoTo 0
End If
If WinTag And Not ShTag Then
MsgBox MSGONLYONE, vbInformation, HEADER
Exit Sub
End If
On Error Resume Next
For Each w1 In Worksheets
'Attempt clearance with PWord1
w1.Unprotect PWord1
Next w1
On Error GoTo 0
ShTag = False
For Each w1 In Worksheets
'Checks for all clear ShTag triggered to 1 if not.
ShTag = ShTag Or w1.ProtectContents
Next w1
If ShTag Then
For Each w1 In Worksheets
With w1
If .ProtectContents Then
On Error Resume Next
Do 'Dummy do loop
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If Not .ProtectContents Then
PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _
Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
MsgBox Application.Substitute(MSGPWORDFOUND2, _
"$$", PWord1), vbInformation, HEADER
'leverage finding Pword by trying on other sheets
For Each w2 In Worksheets
w2.Unprotect PWord1
Next w2
Exit Do 'Bypass all for...nexts
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
Loop Until True
On Error GoTo 0
End If
End With
Next w1
End If
MsgBox ALLCLEAR & AUTHORS & VERSION & REPBACK, vbInformation, HEADER
End Sub

9.test09 聚焦显示

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = 0
Target.EntireColumn.Interior.ColorIndex = 15
Target.EntireRow.Interior.ColorIndex = 15
Target.Interior.ColorIndex = 0
End Sub

10.test10 破解两位数及简单三位数密码

Sub crack()
Dim i As Long
Dim FileName As String
i = 0
FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xlsx）,*.xls;*.xlsx", , "VBA破解")
FileName = Right(FileName, Len(FileName) - InStrRev(FileName, "\"))
Application.ScreenUpdating = False
line2: On Error GoTo line1
Workbooks.Open FileName, , True, , i
MsgBox "Password is " & i
Exit Sub
line1: i = i + 1
Resume line2
Application.ScreenUpdating = True
End Sub

11.test11 bat批量修改文件名

步骤一
dir *.png /b>rename.xls
dir *.后缀名 /b>rename.xls
步骤二
从产生的.xls文件中修改文件名
步骤三
ren 原文件名 现文件名
步骤四
修改为.bat文件

方法二
@echo off
set /p w=请输入文件格式(即扩展名并以回车结束):
set /p wf=请输入要修改的文字(以回车结束):
set /p cb=请输入要改成的文字(若是删除则直接回车，以回车结束):
for /f "delims=" %%i in ('dir /b /a-d "*.%w%"' ) do ( 
set str1=%%i 
setlocal EnableDelayedExpansion
set "str1=!str1:%wf%=%cb%!"
ren "%%i" "!str1!"
endlocal
)
pause

备注：若bat打开出现乱码，鼠标右键，编辑，另存为，编译方式改为ANSI

12.test12 取消所有行列的隐藏

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

13.test13 列转行转置

Sub excel数据整理()

start_row = 2  
start_col = 3
end_col = 6
counts = 40
    For i = 0 To counts
        Range(Cells(start_row + 9 * i, start_col), Cells(start_row + 9 + 9 * i, start_col)).Select
        Selection.Copy
        Cells(i + 1, end_col).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Next i
    
End Sub


注释：
Sub excel数据整理()

start_row = 2  第二列
start_col = 3   第三列
end_col = 6    将数据转置到第六列
counts = 40
    For i = 0 To counts
        Range(Cells(start_row + 9 * i, start_col), Cells(start_row + 9 + 9 * i, start_col)).Select
        Selection.Copy
        Cells(i + 1, end_col).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Next i
    
End Sub

14.test14 复制每一行为多行

1.插入所需空白行
2.全选
3.F5定位空白
4.=+ctrl+方向上键
5.按住ctrl+enter

15.test15 批量取消隐藏并删除隐藏工作表

Sub 批量取消隐藏工作表并且删除()
    Dim sht As Worksheet
    For Each sht In Worksheets
      '如果不是显示状态（返回值是0，也可以写为：(xlSheetVisible)），则删除
        If sht.Visible <> xlSheetVisible Then
            sht.Visible = xlSheetVisible
            Application.DisplayAlerts = False    '删除时不用确认
            sht.Delete
        End If
    Next
   '恢复确认&#xff0c;其实很多人不写这一句&#xff0c;作为小程序写不写倒也无所谓的啦&#xff0c;不影响你后面的程序执行&#xff0c;不过如果你的代码很多&#xff0c;流程很长&#xff0c;建议还是写上去&#xff0c;防止预期之外的的错误发生
    Application.DisplayAlerts = True
End Sub

16.test16 其它功能函数

excel将多列数据集中到一列
=OFFSET($A$1,MOD(ROW(A14),14),CEILING(ROW(A1),14)/14)

excel将一列数据拆分为多列
=OFFSET($A$1,MOD(COLUMN(A1)+7,8)+ROW(A1)*8-7,)

身份证提取出生日期
=CONCATENATE(MID(A2,7,4),"/",MID(A2,11,2),"/",MID(A2,13,2))
 
计算年龄
=TRUNC((DAYS360(C2,"2021/6/22",FALSE))/360,0)
=DATEDIF($C2,TODAY(),"y")
判断男女
=IF(LEN(A2)=15,IF(MOD(MID(A2,15,1),2)=1,"男","女"),IF(MOD(MID(A2,17,1),2)=1,"男","女"))
=IF(MOD(MID(A2,17,1),2)=1,"男","女")

多列拆分
=OFFSET($A$1,INT(COLUMN(C1)/3)+ROW(A1)*5-5,MOD(COLUMN(C1),3))

等差为4的数列
=IF(MOD(ROW(),1)=0,SUM(A1,4),"")
隔一行等差为4的数列
=IF(MOD(ROW(),2)=1,SUM(B1,4),"")
隔两行等差为4的数列
=IF(MOD(ROW(),3)=1,SUM(C1,4),"")
各三行等差为4的数列
=IF(MOD(ROW(),4)=1,SUM(D1,4),"")
隔4行等比为4的数列
=IF(MOD(ROW(),4)=1,PRODUCT(F1,4),"")

引用指定单元格为工作表名的指定数据
=INDIRECT("'"&A2&"'"&"!FV7")

输出不重复项
=INDEX(抽检数据!C3:C8888,MATCH(,COUNTIFS($C1:C$1,抽检数据!C4:C8888),)+1)&""
=LOOKUP(,1/(COUNTIF(E$1:E1,抽检数据!$C$3:$C$5589)-1),抽检数据!C$3:C$5589)

条件求和
=SUMIF(D2:D5,F2,C2:C5)
多条件求和
=SUMIFS(D2:D9,B2:B9,F2,C2:C9,G2)
条件计数
=COUNTIF(B2:B12,E3)
多条件计数
=COUNTIFS(B2:B9,F2,C2:C9,G2)
条件查找
=VLOOKUP($F$5,$B$1:$D$10,2,0)
多条件查找
=LOOKUP(1,0/((B2:B9=F2)*(C2:C9=G2)),A2:A9)

多列中都有的数据判断：
=IF(AND(COUNTIF(B:B,E1),COUNTIF(C:C,E1),COUNTIF(A:A,E1)),"√","")
或=COUNTIF(A:A,E1)*COUNTIF(B:B,E1)*COUNTIF(C:C,E1)

---

总结

以上就是今天要讲的内容，本文仅仅简单介绍了部分常用公式和VBA的使用，其中错误的地方欢迎大家批评指正。