日期递增代码
Sub 日期递增代码()
Dim i As Variant
For i = 2 To 31
Worksheets(i).[a1] = Worksheets(1).Range("a1").Value + i - 1
Next
End Sub

生成工作表
复制内容
Sub 生成工作表()
Dim i%
For i = 1 To 28
Sheets.Add After:=Sheets(Sheets.Count) '在sheet3后面新建28个sheets
Next
End Sub
Sub 复制工作表内容()
For i = 3 To 31
Sheets("Sheet2").Select
Cells.Select
Selection.Copy
Worksheets(i).Select '把sheet2的内容复制到 sheet3:31
Range("A1").Select
ActiveSheet.Paste
Next
End Sub

正则表达式

Sub df()
Dim regEX As New RegExp '定义一个正则表达式对象
regEX.Pattern = "\((\d{3,4})\)(\d{7,8})" '设置正则表达式
For i = 1 To 14
Range("c" & i) = regEX.Replace(Range("a" & i), "$1-$2")
Next
End Sub

筛选重复与不重复的数据
Sub 筛选数据()
t = [a1].End(xlDown).Row
Set arr = Range("a1:a" & t)
For Each m In arr
For Each n In arr
a = m.Value
b = n.Value
If a = b Then
k = k + 1
End If
Next
If k = 1 Then
i = i + 1
Cells(i, "F") = a '将不重复的数据放在F列
Else
q = q + 1
Cells(q, "G") = a '将重复的数据放在G列
End If
k = 0
Next
r = [g1].End(xlDown).Row
Range("g1:g" & r).RemoveDuplicates Columns:=1, Header:=xlNo '删除重复项
End Sub

Sub 汇总回抄()
For Each st In Worksheets
If st.Name <> "sheet32" Then
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
st.Select
ActiveWorkbook.RunAutoMacros Which:=xlAutoActivate
Range("G9", [h30].End(3).Offset(1, 0)).Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet32").Select
[a1000].End(3).Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
End Sub
汇总回抄吨数