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
该代码仅供学习,如商业转载请联系本人,非商业转载请注明出处

Logo

欢迎加入 MCP 技术社区!与志同道合者携手前行,一同解锁 MCP 技术的无限可能!

更多推荐