簡單復(fù)制-去重-做透視表

Sub 宏3()
Application.ScreenUpdating = False '關(guān)閉屏幕更新，看不到宏的執(zhí)行過程，但提高宏運(yùn)行速度
Application.EnableEvents = False '關(guān)閉事件，防止觸發(fā)事情，提高運(yùn)行速度
t = Timer
'復(fù)制-去重
'Worksheets("處理結(jié)果").Range("A:C").ClearContents
Worksheets("派單明細(xì)報(bào)表").Select
Range("E:E,O:O,U:U").Select
Selection.Copy
Worksheets("處理結(jié)果").Select
Columns("A:C").Select
ActiveSheet.Paste
Application.CutCopyMode = False
irow = Range("a1").CurrentRegion.Rows.Count
ActiveSheet.Range("A1:C" & irow).RemoveDuplicates Columns:=Array(1, 2, 3), _
Header:=xlYes

 '透視表
 Worksheets("處理結(jié)果").Range("J:N").ClearContents
 'irow = Range("a1").CurrentRegion.Rows.Count '選擇最大行
 'aa = Range("A1:C" & irow).Select
 'R1C1:R1048576C3
 ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "處理結(jié)果!R1C1:R1048576C3", Version:=6).CreatePivotTable TableDestination:= _
    "處理結(jié)果!R2C10", TableName:="數(shù)據(jù)透視表2", DefaultVersion:=6
Sheets("處理結(jié)果").Select
Cells(2, 10).Select
ActiveSheet.PivotTables("數(shù)據(jù)透視表2").RepeatAllLabels xlRepeatLabels
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("數(shù)據(jù)透視表2").PivotFields("發(fā)貨區(qū)域")
    .Orientation = xlRowField
    .Position = 1
End With
With ActiveSheet.PivotTables("數(shù)據(jù)透視表2").PivotFields("派單類型")
    .Orientation = xlColumnField
    .Position = 1
End With
ActiveSheet.PivotTables("數(shù)據(jù)透視表2").AddDataField ActiveSheet.PivotTables("數(shù)據(jù)透視表2" _
    ).PivotFields("派單單號(hào)"), "計(jì)數(shù)項(xiàng):派單單號(hào)", xlCount
ActiveWorkbook.ShowPivotTableFieldList = False

Worksheets("處理結(jié)果").Range("A:C").ClearContents
MsgBox Timer - t & "秒完成"
Application.ScreenUpdating = True '結(jié)束屏幕更新

End Sub

VBA 字典多表匹配

----------------------------------------------------------------------------------------------------------------------------------------

'三表之中sheet1、sheet2、sheet3 匹配(把sheet2合同號(hào)、sheet3合同號(hào)匹配到sheet1里面去)
Sub nihao1()
Windows("信貸數(shù)據(jù)匹配.xlsm").Activate
Worksheets("Sheet1").Select
Worksheets("Sheet2").Select
Sheets("Sheet3").Select
Dim i&, Myr&, arr, j&
Dim d, k, t, m&, Arr1
Set d = CreateObject("Scripting.Dictionary") '定義字典'
Set d2 = CreateObject("Scripting.Dictionary") '定義字典'
'Set d2 = CreateObject("Scripting.Dictionary") '定義字典'
'Set d3 = CreateObject("Scripting.Dictionary") '定義字典'
'Set d4 = CreateObject("Scripting.Dictionary") '定義字典'
'Set d5 = CreateObject("Scripting.Dictionary") '定義字典'
'y = d(Arr(Range("c1:c200"))) + 1
Worksheets("Sheet3").Select '開始運(yùn)行字典'
With Sheets("Sheet3")
X = Range("b1").CurrentRegion.Rows.Count '設(shè)置最大行'
For i = 2 To X
d(.Cells(i, 2).Value) = .Cells(i, 2).Value
'd2(.Cells(i, 2).Value) = .Cells(i, 2).Value
' d2(.Cells(i, 2).Value) = .Cells(i, 7).Value
' d3(.Cells(i, 2).Value) = .Cells(i, 8).Value
' d4(.Cells(i, 2).Value) = .Cells(i, 9).Value
' d5(.Cells(i, 2).Value) = .Cells(i, 10).Value
'd1(.Cells(i, 1).Value) = .Cells(i, 3).Value
Next i
End With

Worksheets("Sheet2").Select '開始運(yùn)行字典'
With Sheets("Sheet2")
X1 = Range("b1").CurrentRegion.Rows.Count '設(shè)置最大行'
For i1 = 2 To X1
d2(.Cells(i1, 2).Value) = .Cells(i1, 2).Value
'd1(.Cells(i, 2).Value) = .Cells(i, 2).Value
' d2(.Cells(i, 2).Value) = .Cells(i, 7).Value
' d3(.Cells(i, 2).Value) = .Cells(i, 8).Value
' d4(.Cells(i, 2).Value) = .Cells(i, 9).Value
' d5(.Cells(i, 2).Value) = .Cells(i, 10).Value
'd1(.Cells(i, 1).Value) = .Cells(i, 3).Value
Next i1
End With

Sheets("Sheet1").Select
With Sheets("Sheet1")
y = Range("b1").CurrentRegion.Rows.Count '設(shè)置最大行'
For Z = 2 To y
.Cells(Z, 4).Value = d(.Cells(Z, 1).Value)
.Cells(Z, 3).Value = d2(.Cells(Z, 1).Value)
' .Cells(Z, 23).Value = d3(.Cells(Z, 2).Value)
' .Cells(Z, 24).Value = d4(.Cells(Z, 2).Value)
' .Cells(Z, 25).Value = d5(.Cells(Z, 2).Value)
'.Cells(Z, 21).Value = d1(.Cells(Z, 1).Value)
Next Z

End With

End Sub

（1.1）VBA批量打開桌面文件夾里面多個(gè)工作簿 -------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub test()
Dim mypath, myfile '定義
mypath = "C:\Users\xn084037\Desktop" & "\nihao" '指定路徑nihao文件夾名
myfile = Dir(mypath & "*.xlsx") '指定文件家里面的工作簿(文件夾下面有多個(gè)工作簿)
Application.ScreenUpdating = False '關(guān)閉屏幕更新
Application.DisplayAlerts = False '關(guān)閉提示框
Do While myfile <> ""
If myfile <> ThisWorkbook.Name Then
Workbooks.Open mypath & myfile

'With ActiveWorkbook '批量操作的語句
'.Sheets(1).Range("A1") = "金額"
'.Sheets(2).Delete
'End With
'ActiveWorkbook.Save
'ActiveWorkbook.Close
End If
myfile = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True

（1.2）VBA批量打開桌面文件夾里面多個(gè)工作簿并且把數(shù)據(jù)復(fù)制到匯總表

Sub test1()
t = Timer
p = "C:\Users\xn084037\Desktop" & "\同一個(gè)文件夾不同工作簿分案清單合并VBA" '指定文件路徑
f = Dir(p & "*.xlsx") '指定文件夾旗下多個(gè)工作簿
Application.ScreenUpdating = False '關(guān)閉屏幕顯示
ReDim brr(1 To 100000, 1 To 26) '定義匯總表數(shù)組范圍
Do While f <> ""
If f <> ThisWorkbook.Name Then
n = n + 1 '文件夾里面工作簿個(gè)數(shù)
Set sh = GetObject(p & f).Sheets(1) '打開這些文件夾旗下所有工作簿的一個(gè)sheets
Arr = sh.[a1].CurrentRegion '定義Arr數(shù)據(jù)范圍為每個(gè)sheets的a1單元格不為空區(qū)域
Workbooks(f).Close False
For i = 2 To UBound(Arr) '子表中行的取值范圍
m = m + 1 '匯總表中第一行為表頭,第一次循環(huán)時(shí)，匯總表中為2行才是填充數(shù)據(jù)，所以m=m+1就是匯總表中的步長，
'brr(m, 1) = Arr(i, 4)
For j = 1 To 26 '列的取值范圍
brr(m, j) = Arr(i, j) 'brr(m, j)是匯總表數(shù)組，Arr(i, j)是子表數(shù)組
Next
Next
End If
f = Dir
Loop
Set sh = Nothing '釋放內(nèi)存
If m > 0 Then
[a1].CurrentRegion.Offset(1).ClearContents '可以在保留第一行表頭的情況下，把其他行的數(shù)據(jù)都徹底刪除。
[a2].Resize(m, 26) = brr
End If
Application.ScreenUpdating = True
MsgBox "合并了：" & n & "個(gè)文件；共有：" & m & "行數(shù)據(jù)。" & "用時(shí)：" & Format(Timer - t, "0.00") & "秒" '顯示
End Sub

（1）執(zhí)行打開已隱藏輔助表功能

Sub chuxian() '執(zhí)行打開已隱藏輔助表功能
Worksheets("總回退").Visible = True
Worksheets("總回退輔表").Visible = True
Worksheets("總回收率").Visible = True
Worksheets("總回收率輔表").Visible = True
Worksheets("跑出的數(shù)據(jù)").Visible = True
Worksheets("批量添加").Visible = True
Worksheets("M3回收率").Visible = True
Worksheets("M3").Visible = True
Worksheets("M2_1回收率").Visible = True
Worksheets("M2-1").Visible = True
Worksheets("M2_2回收率").Visible = True
Worksheets("M2-2").Visible = True
Worksheets("異常處理").Visible = True
End Sub

（2）類似于excel中sumifs函數(shù)

Sub match_caculate() '本代碼主要功能是類似于excel中sumifs函數(shù) 通過工號(hào)匹配可算回款數(shù)據(jù)，生成第八列員工實(shí)際回款、第9列回收率=員工實(shí)際回款/逾期金額、'第10列排名

Sheets("總回收率").Select '選擇對象總回收率這個(gè)sheet(總回收率的數(shù)據(jù)先從數(shù)據(jù)庫跑出來)

a = Range("a1").CurrentRegion.Rows.Count '選擇最大行

For i = 2 To a ' 循環(huán)的寫法
'類似于excel中sumifs函數(shù) 通過工號(hào)匹配可算回款數(shù)據(jù)
Cells(i, 8) = WorksheetFunction.SumIfs(Sheets("可算回退").Range("J:J"), Sheets("可算回退").Range("B:B"), Sheets("總回收率").Range("B" & i)) '第八列員工實(shí)際回款

Cells(i, 9) = Cells(i, 8) / Cells(i, 7) '第9列回收率=員工實(shí)際回款/逾期金額

Cells(i, 10) = i - 1 '第10列排名

Next i

End Sub

（3）填充功能

Sub add_() '填充功能

Worksheets("可算回退輔表").Select '選擇對象批可算回退輔表這個(gè)sheet

Range("A1") = "合同&工號(hào)" '可算回退輔表的A1單元格=合同&工號(hào)

a = Range("B1").CurrentRegion.Rows.Count '取最大行

Range("A2").FormulaR1C1 = "=RC[1]&RC[2]" 'B2列&C2列（合同&工號(hào)）

Range("A2").AutoFill Destination:=Range("A2:A" & a), Type:=xlFillDefault '填充

Worksheets("批量處理").Select '選擇對象批量處理這個(gè)sheet

b = Range("B1").CurrentRegion.Rows.Count '取最大行

Range("C2").AutoFill Destination:=Range("C2:C" & b), Type:=xlFillDefault '填充

Range("D2").AutoFill Destination:=Range("D2:D" & b), Type:=xlFillDefault '填充

Range("E2").AutoFill Destination:=Range("E2:E" & b), Type:=xlFillDefault '填充

Range("F2").AutoFill Destination:=Range("F2:F" & b), Type:=xlFillDefault '填充

Range("G2").AutoFill Destination:=Range("G2:G" & b), Type:=xlFillDefault '填充

Range("H2").AutoFill Destination:=Range("H2:H" & b), Type:=xlFillDefault '填充

Range("J2").AutoFill Destination:=Range("J2:J" & b), Type:=xlFillDefault '填充

Range("K2").AutoFill Destination:=Range("K2:K" & b), Type:=xlFillDefault '填充

Range("M2").AutoFill Destination:=Range("M2:M" & b), Type:=xlFillDefault '填充

Range("N2").AutoFill Destination:=Range("N2:N" & b), Type:=xlFillDefault '填充

End Sub

（4）主要執(zhí)行xindai 表清空、篩選、選擇最大行、復(fù)制、粘貼、排序、排名、循環(huán)、日期格式、調(diào)整百分比、隱藏各個(gè)輔助表功能

Sub Seperate() '主要執(zhí)行xindai 表清空、篩選、選擇最大行、復(fù)制、粘貼、排序、排名、循環(huán)、日期格式、調(diào)整百分比、隱藏各個(gè)輔助表功能

' ps = "是"
'
' msg = Application.InputBox(prompt:="請問是否處理了異常數(shù)據(jù)調(diào)整表的異常及回收率表的pick_me", Type:=1 + 2)
' If msg <> ps Then MsgBox "請先處理異常數(shù)據(jù)調(diào)整表的異常": Exit Sub

T = Timer '定義時(shí)間

'Call toushibiao

' If Worksheets("總回收率").Range("N4").Value = False Then
' MsgBox ("數(shù)據(jù)存在異常，請核實(shí)"): Exit Sub
' ElseIf Worksheets("總回收率").Range("N4").Value = True Then
' MsgBox ("數(shù)據(jù)無誤，繼續(xù)執(zhí)行")
' End If

' msg = Application.InputBox(prompt:="是否需要剔除委案", Type:=1 + 2)
' If msg = ps Then
' Call 剔除委案
' End If

'清空區(qū)域

Worksheets("M1回收率").Columns("A:L").ClearContents '清空代碼

Worksheets("M2回收率").Columns("A:L").ClearContents '清空代碼

Worksheets("M1回退").UsedRange.ClearContents '清空代碼

Worksheets("M2回退").UsedRange.ClearContents '清空代碼

Worksheets("可算回退輔表").Columns("B:O").ClearContents '清空代碼

'Sheets("可算回退").UsedRange.EntireColumn.AutoFit

'復(fù)制數(shù)據(jù)至輔表

Worksheets("可算回退").Select ' 選擇對象可算回退這個(gè)sheet

Columns("A:J").Copy '復(fù)制可算回退A-J列

Worksheets("可算回退輔表").Select ' 選擇對象可算回退輔表這個(gè)sheet

Worksheets("可算回退輔表").Range("B1").Select '選擇對象可算回退輔表這個(gè)sheet的B1

     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False '執(zhí)行粘貼代碼

'Columns("C:C").Insert Shift:=xlToRight

Columns("F:F").Select '選擇對象F列

Selection.NumberFormatLocal = "yyyy/mm/dd" '把F列的日期格式設(shè)置為年月日（yyyy/mm/dd）

Columns("J:J").Select '選擇對象J列

Selection.NumberFormatLocal = "yyyy/mm/dd" '把J列的日期格式設(shè)置為年月日（yyyy/mm/dd）

'復(fù)制數(shù)據(jù)至各子表

'表1

Worksheets("可算回退輔表").Select ' 選擇對象可算回退輔表這個(gè)sheet

a = Range("A1").CurrentRegion.Rows.Count '選擇最大行

Set edg = Worksheets("可算回退輔表").UsedRange

ActiveSheet.Range("B1:O1").AutoFilter field:=4, Criteria1:="M1" '篩選第四列=M1數(shù)據(jù)

edg.Copy '復(fù)制

Worksheets("M1回退").Select '選擇對象M1回退這個(gè)sheet

Worksheets("M1回退").Range("A1").Select '選擇對象M1回退這個(gè)sheet的A1列

ActiveSheet.Paste '執(zhí)行粘貼

Application.CutCopyMode = False

'表2

Worksheets("可算回退輔表").Select ' 選擇對象可算回退輔表這個(gè)sheet

ActiveSheet.Range("B1:O1").AutoFilter field:=4, Criteria1:="M2" '篩選第四列=M2數(shù)據(jù)

edg.Copy '執(zhí)行復(fù)制

Worksheets("M2回退").Select '選擇對象M2回退這個(gè)sheet

Worksheets("M2回退").Range("A1").Select '選擇對象M2回退這個(gè)sheet的A1列

ActiveSheet.Paste '執(zhí)行粘貼

Application.CutCopyMode = False

Worksheets("可算回退輔表").Select ' 選擇對象可算回退輔表這個(gè)sheet

Worksheets("可算回退輔表").Range("A1:M1").AutoFilter

'總回收率調(diào)整格式

Worksheets("總回收率").Select '選擇對象總回收率這個(gè)sheet

x = Range("A1").CurrentRegion.Rows.Count '選擇最大行

Dim rng As Range '定義 rng As Range

Set rng = Range("A1:J" & x) '選定范圍

rng.Sort key1:="員工實(shí)際回款", order1:=xlDescending, Header:=xlYes '對員工實(shí)際回款這列進(jìn)行降序排序

For i = 2 To x

Range("J" & i) = i - 1 '對J列排名

Range("H2:H" & x).Select '選擇 H2所在列

Selection.NumberFormatLocal = "G/通用格式" '調(diào)整格式

Range("I2:I" & x).Select '選擇I2所在列

Selection.NumberFormatLocal = "0.00%" '調(diào)整百分比為2位小數(shù)點(diǎn)

'總回收率的數(shù)據(jù)拆分至各子表
'表1

Worksheets("總回收率").Select '選擇對象總回收率這個(gè)sheet

Range("A1:J" & x).AutoFilter field:=4, Criteria1:="M1" '篩選第四列=M1數(shù)據(jù)

rng.Copy '執(zhí)行復(fù)制

Worksheets("M1回收率").Select '選擇對象M1回收率這個(gè)sheet

Worksheets("M1回收率").Range("A1").Select '選擇對象M1回收率這個(gè)sheet的A1列

ActiveSheet.Paste '執(zhí)行粘貼代碼

Y = Range("A1").CurrentRegion.Rows.Count '選擇最大行

For i = 2 To Y '循環(huán)

Range("J" & i) = i - 1 '對J列排名

Application.CutCopyMode = False

'表2

Worksheets("總回收率").Select '選擇對象總回收率這個(gè)sheet

Range("A1:J" & x).AutoFilter field:=4, Criteria1:="M2" '篩選第四列=M2數(shù)據(jù)

rng.Copy '執(zhí)行復(fù)制代碼

Worksheets("M2回收率").Select '選擇對象M2回收率這個(gè)sheet

Worksheets("M2回收率").Range("A1").Select '選擇對象M2回收率這個(gè)sheet的A1列

ActiveSheet.Paste '執(zhí)行粘貼

Y = Range("A1").CurrentRegion.Rows.Count '選擇最大行

For i = 2 To Y '循環(huán)

Range("K" & i) = i - 1 'K列排名

Application.CutCopyMode = False

Worksheets("總回收率").Range("a1:j1").AutoFilter

MsgBox Timer - T & "秒完成嘿嘿" '程序執(zhí)行后提示完成時(shí)間

Set rng = Nothing '釋放 rng

Set edg = Nothing '釋放 edg

'以下代碼是隱藏各個(gè)輔助表
Worksheets("可算回退").Visible = False

Worksheets("可算回退輔表").Visible = False

Worksheets("總回收率").Visible = False

Worksheets("M2回退").Visible = False

Worksheets("M2回收率").Visible = False

Worksheets("跑出后的數(shù)據(jù)").Visible = False

Worksheets("批量處理").Visible = False