【007】Excel宏编程相关封装模块(筛选、复制、黏贴)_001_#VBA
1. 说明该模块是根据Excel宏编程官网及录制时相关操作进行编写的,如有不足之处,望批评指正!!!2. 代码2.1 筛选相关内容,且复制筛选内容筛选内容前,需将相应表格置于活动表格需要同时筛选一个内容Function AssistFileSelVol(Filename, SheetName, Item, Step, T)'选择对应的工步并进行单步复制 _ 文件名_工作薄名_第几列进行筛选_工步序
·
Excel宏编程相关封装模块-第1期
1. 说明
该模块是根据Excel宏编程官网及录制时相关操作进行编写的,如有不足之处,望批评指正!!!
2. 代码
2.1 筛选相关内容,且复制筛选内容
筛选内容前,需将相应表格置于活动表格
需要同时筛选一个内容
Function AssistFileSelVol(Filename, SheetName, Item, Step, T)
'选择对应的工步并进行单步复制 _ 文件名_工作薄名_第几列进行筛选_工步序号_按需要切换列数
Windows(Filename).Activate
Sheets(SheetName).Select
If T = 1 Then
ActiveSheet.Range("$A$1:$L$1").AutoFilter Field:=Item, Criteria1:=Step
Range(Columns(8), Columns(9)).Select: Selection.Copy
ElseIf T = 0 Then
ActiveSheet.Range("$A$1:$L$1").AutoFilter Field:=Item, Criteria1:=Step
Range(Columns(9), Columns(9)).Select: Selection.Copy
ElseIf T = 3 Then
Range(Columns(3), Columns(3)).Select: Selection.Copy
ElseIf T = 5 Then
ActiveSheet.Range("$A$1:$L$1").AutoFilter Field:=Item, Criteria1:=Step
Range(Columns(5), Columns(5)).Select: Selection.Copy
End If
End Function
Function AssistSelVol(SheetName, Item, Step, T)
'选择对应的工步并进行单步复制 _ 工作薄名_第几列进行筛选_工步序号_按需要切换列数
Sheets(SheetName).Select
ActiveSheet.Range("$A$1:$L$1").AutoFilter Field:=Item, Criteria1:=Step
If T = 1 Then
Range(Columns(8), Columns(9)).Select
Selection.Copy
Else
Range(Columns(9), Columns(9)).Select
Selection.Copy
End If
End Function
需要同时筛选两个内容
Function AssistFileTwoSelVol(Filename, SheetName, Item, Two_Endto, T)
'选择对应的工步并进行两步复制 _ 文件名_工作薄名_第几列进行筛选_多个工步序号_按需要切换列数
Windows(Filename).Activate
Sheets(SheetName).Select
Dim DQ41 As String, DQ42 As String
DQ41 = Two_Endto(1)
DQ42 = Two_Endto(2)
ActiveSheet.Range("$A$1:$L$41500").AutoFilter Field:=2, Criteria1:=DQ41, _
Operator:=xlOr, Criteria2:=DQ42
If T = 1 Then
Range(Columns(8), Columns(9)).Select
Selection.Copy
Else
Range(Columns(9), Columns(9)).Select
Selection.Copy
End If
End Function
Function AssistTwoSelVol(SheetName, Item, Two_Endto, T)
'选择对应的工步并进行两步复制 _ 工作薄名_第几列进行筛选_多个工步序号_按需要切换列数
Sheets(SheetName).Select
Dim DQ41 As String, DQ42 As String
DQ41 = Two_Endto(1)
DQ42 = Two_Endto(2)
ActiveSheet.Range("$A$1:$L$41500").AutoFilter Field:=2, Criteria1:=DQ41, _
Operator:=xlOr, Criteria2:=DQ42
If T = 1 Then
Range(Columns(8), Columns(9)).Select
Selection.Copy
Else
Range(Columns(9), Columns(9)).Select
Selection.Copy
End If
End Function
因需同时筛选三个内容,故有数组的形式进行内容输入,使用时逐一赋值
Function AssistFileMultiSelVol(Filename, SheetName, Item, Third_Endto, T)
'选择对应的工步并进行三步复制 _ 文件名_工作薄名_第几列进行筛选_多个工步序号_按需要切换列数
Windows(Filename).Activate
Sheets(SheetName).Select
Dim DQ41 As String, DQ42 As String, DQ43 As String
DQ41 = Third_Endto(1)
DQ42 = Third_Endto(2)
DQ43 = Third_Endto(3)
ActiveSheet.Range("$A$1:$L$59464").AutoFilter Field:=Item, Criteria1:=Array( _
DQ41, DQ42, DQ43), Operator:=xlFilterValues
If T = 1 Then
Range(Columns(8), Columns(9)).Select
Selection.Copy
Else
Range(Columns(9), Columns(9)).Select
Selection.Copy
End If
End Function
Function AssistMultiSelVol(SheetName, Item, Third_Endto, T)
'选择对应的工步并进行三步复制 _ 工作薄名_第几列进行筛选_多个工步序号_按需要切换列数
Sheets(SheetName).Select
Dim DQ41 As String, DQ42 As String, DQ43 As String
DQ41 = Third_Endto(1)
DQ42 = Third_Endto(2)
DQ43 = Third_Endto(3)
ActiveSheet.Range("$A$1:$L$59464").AutoFilter Field:=Item, Criteria1:=Array( _
DQ41, DQ42, DQ43), Operator:=xlFilterValues
If T = 1 Then
Range(Columns(8), Columns(9)).Select
Selection.Copy
Else
Range(Columns(9), Columns(9)).Select
Selection.Copy
End If
End Function
2.2 区域内容复制
单个数据进行复制
Function AssistFileCopy(Filename, SheetName, H, l)
'将所选择的数据进行复制 _ 文件名_工作薄名_,,所在位置
Windows(Filename).Activate
Sheets(SheetName).Select
Cells(H, l).Select
Selection.Copy
End Function
Function AssistCopy(SheetName, H, l)
'将所选择的数据进行复制 _ 工作薄名_,,所在位置
Sheets(SheetName).Select
Cells(H, l).Select
Selection.Copy
End Function
范围性数据选中进行复制
Function AssistFileRangeCopy(Filename, SheetName, H1, L1, H2, L2)
'将所选择的范围数据进行复制 _ 文件名_工作薄名_ ,,首位_,,末位
Windows(Filename).Activate
Sheets(SheetName).Select
Range(Cells(H1, L1), Cells(H2, L2)).Select
Selection.Copy
End Function
Function AssistRangeCopy(SheetName, H1, L1, H2, L2)
'将所选择的范围数据进行复制 _ 工作薄名_ ,,首位_,,末位
Sheets(SheetName).Select
Range(Cells(H1, L1), Cells(H2, L2)).Select
Selection.Copy
End Function
2.3 黏贴
无其他操作,直接进行黏贴
Function AssistFilePaste(Filename, SheetName, H, l)
'将所选择的数据进行黏贴 _ 文件名_工作薄名_,,所在位置
Windows(Filename).Activate
Sheets(SheetName).Select
Cells(H, l).Select
ActiveSheet.Paste
End Function
Function AssistPaste(SheetName, H, l)
'将所选择的数据进行黏贴 _ 工作薄名_,,所在位置
Sheets(SheetName).Select
Cells(H, l).Select
ActiveSheet.Paste
End Function
对复制内容进行转置黏贴
Function AssistFilePasteTrans(Filename, SheetName, H, l)
'将所选择的数据进行转置黏贴 _ _ 文件名_工作薄名_,,所在位置
Windows(Filename).Activate
Sheets(SheetName).Select
Cells(H, l).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Function
Function AssistPasteTrans(SheetName, H, l)
'将所选择的数据进行转置黏贴 _ 工作薄名_,,所在位置
Sheets(SheetName).Select
Cells(H, l).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Function
参考地址:https://docs.microsoft.com/zh-cn/office/client-developer/excel/excel-home?redirectedfrom=MSDN
该代码仅供学习,如商业转载请联系本人,非商业转载请注明出处
更多推荐


所有评论(0)