' 宏1 宏
' 超链接
Dim p$, f$, i As Integer
i = 1
国创撰写\\" & ""
取得第一个pdf文件名
循环语句
Sheets(1).Cells(i, 1).Value = f 'Range("a1").Value = p & f
显示路径加文件名
f = Dir '第二个文件名
End Sub
Private Sub CommandButton1_Click() 随机选择器
Dim a, b, c, d As String
Dim shu As Integer
Dim arr(1 To 4)
shu = Int((4 * Rnd) + 1)
arr(1) = TextBox1.Value
arr(2) = TextBox2.Value
arr(3) = TextBox3.Value
arr(4) = TextBox4.Value
MsgBox "excel推荐你今天应该吃" & arr(shu)
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Sub 批量新建指定名称工作簿()
Application.DisplayAlerts = False
For i = 1 To 54 ' 个数减一
Dim Rng As String
Dim abc As Range
Dim wb As Workbook
Dim wb1 As Workbook
Set wb1 = ThisWorkbook
With ActiveCell
Rng = .Value
Set abc = .Offset(1, 0)
End With
Dim a As Range
Dim b As Long
b = 0
ActiveCell.Offset(b, 0).EntireRow.Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
abc.Select
Range("A1").EntireRow.Copy abc.Offset(b, -4)
Set wb = Workbooks.Add
'Filename:=ThisWorkbook.Path & Application.PathSeparator & Rng & ".xls"
wb1.Sheets(1).Activate
abc.CurrentRegion.Copy
wb.Sheets(1).Activate
wb.Sheets(1).Paste
wb.SaveAs "C:\\Users\\Administrator\\Desktop\团队人员统计\\" & Rng & ".xlsx" '之前忘了保存了
wb.Close
wb1.Sheets(1).Activate
abc.Offset(b + 1, 0).Select
Next
Application.DisplayAlerts = True
End Sub
Sub 输入输出()
Dim abc As String
abc = InputBox("你想问什么", "这是一个标题")
Call MsgBox("房主你最帅 ^ ^", 0, "这是标题")
'加了括号一定要返回值，或者加call
'Dim wb As Workbook
' Set wb = Workbooks.Add
' wb.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & "woshi.xls" '搞定名称啦！
Sub 自动分组打印6_Click()
For i = 1 To 35
Dim Rng As String
Dim abc As Range
With ActiveCell
Rng = .Value
Set abc = .Offset(1, 0)
End With
Dim a As Range
Dim b As Integer
b = 0
ActiveCell.Offset(b, 0).EntireRow.Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
abc.Select
Worksheets("团队出勤").PageSetup.PrintArea = abc.CurrentRegion.Address
Worksheets("团队出勤").PrintOut
Range("a1").EntireRow.Copy abc.Offset(b, 0)
abc.Offset(b + 1, 0).Select
Next
End Sub
Public Sub 多个工作表复制汇总()
Dim p$, f$, z$, i As Integer
Dim wb As Worksheet
Dim wb1 As Workbook
Dim rng As Range
Application.ScreenUpdating = False
Set wb = ThisWorkbook.Worksheets(1)
学习\大二下\\srp创新网络与创新绩效\新建文件夹\第五阶段数据编码47—80\第四阶段数据编码47—80\\" & ""
取得第一个excel文件名
循环语句
Set rng = wb.Range("A1048576").End(xlUp).Offset(1, 0) ' ‘Set wb1 = "D:\学习\大二下\\srp创新网络与创新绩效\新建文件夹\第五阶段数据编码47—80\第四阶段数据编码47—80\\" & f
Selection.AutoFilter '筛选 已验证过没问题
发明申请"
显示路径加文件名
f = Dir '第二个文件名
Application.ScreenUpdating = True
End Sub
Sub 股票分类建立工作表()
Application.DisplayAlerts = False
Dim Rng As String
Dim abc As Range
Dim b As Integer
Dim a As Range
Dim sht As Worksheet
Rng = Worksheets("沪深300成分股10年").Range("b2").Value
Set abc = Worksheets("沪深300成分股10年").Range("b2")
Do While Rng <> ""
沪深300成分股10年").Activate
沪深300成分股10年").Activate
Set abc = abc.Offset(b + 1, 0)
Loop
End Sub
Sub 遍历工作表求偏度峰度
Next
End Sub
Sub 求单只股票每一年风度偏度()
'
Sub 每年()
'
' 每年 宏
Dim rng, rng1, rng2 As Range
Dim a, c, e, d As String
Dim sheet As Worksheet
Dim b, i, f As Long
Application.ScreenUpdating = false
For Each sheet In Sheets
选中活动工作表
‘k = ActiveSheet.Range("A1").CurrentRegion.Rows.Count ‘ 取得最后一行的行号 k 为long
Set rng = ActiveSheet.Range("A1048576").End(xlUp) '获得最后一个非空单元格
非空单元格的行号
输入文本
自动填充所有行
Do While rng1 <> ""
获得每一年的个数
计算
next
-探戈写的代码：Sub test2()
Dim Filename As String, wb As Workbook, Erow As Long, fn As String, bj As Variant, i As Long, k As Long, j As Long, l As Long
Filename = Dir(ThisWorkbook.Path & "\\*.xls")
Do While Filename <> ""
If Filename <> ThisWorkbook.Name Then
fn = ThisWorkbook.Path & "\\" & Filename
Workbooks.Open (fn)
With ActiveWorkbook.Worksheets(1)
Cells(65536, "A").End(xlUp).EntireRow.Delete
Erow = Cells(65536, "C").End(xlUp).Row
Cells(3, "F").FormulaR1C1 = "=Year(RC[-3])"
Cells(3, "F").AutoFill Destination:=Range(Cells(3, "F"), Cells(Erow, "F"))
Cells(1, "G") = "年份"
Cells(1, "H") = "峰度"
Cells(1, "I") = "偏度"
i = 3
l = 3
bj = Cells(i, "F").Value
k = 2007
j = 3
Do While k <> 2018
Do While bj = k
bj = Cells(i, "F").Value
i = i + 1
Loop
Cells(j, "H").Formula = "=KURT(R" & l & "C5:R" & i & "C5)"
Cells(j, "I").Formula = "=SKEW(R" & l & "C5:R" & i & "C5)"
Cells(j, "G").Value = k
l = i + 1
k = k + 1
j = j + 1
Loop
End With
ActiveWorkbook.Close savechanges:=True
End If
Filename = Dir
Loop
End Sub
使用cells.formula 调用工作表函数
Cells(1, 1).Formula = "=sum（d" & l & ":d3) "
Sub 计算个股（单个工作簿工作表）的收益率和偏度峰度a()
'
Sub 计算偏度峰度a()
'
' 每年 宏
Dim rng, rng1, rng2, rng3 As Range
Dim a, c, e, d As String
Dim sheet As Worksheet
Dim b, i, f, k As Long
Dim filename, fn As String
filename = Dir(ThisWorkbook.Path & "\\*.xls")
Application.ScreenUpdating = False
Do While filename <> ""
ActiveSheet.Range("g2").Value = "长期收益率"
ActiveSheet.Range("h2").Value = "长期峰度"
长期偏度"
每年收益率"
每年峰度"
每年偏度"
（e3:e" & k & ") " '算十年
：e" & k & ") "
选中活动工作表
非空单元格的行号
输入文本
自动填充所有行
Do While rng1 <> ""
获得每一年的个数
（e" & c & ":e" & d & ") "
（e" & c & ":e" & d & ") "
ActiveWorkbook.Close savechanges:=True
End If
End Sub
------------批量总表
Dim a, c, e, d As String
Dim sheet As Worksheet
Dim b, i, f, k As Long
Dim filename, fn As String
filename = Dir(ThisWorkbook.Path & "\\*.xls")
Application.ScreenUpdating = False
Set rng1 = ThisWorkbook.Sheets(1).Range("a1048576").End(xlUp).Offset(1, 0)
i = 1
Do While filename <> ""
If filename <> ThisWorkbook.Name Then
ActiveWorkbook.Close savechanges:=True
End If
i= i+1
End Sub
Public Sub 汇总工作簿的不同工作表()
Dim f$, z$, i As Long '定义变量
Dim wb As Worksheet
Dim wb1 As Workbook
Dim rng As Range
Application.ScreenUpdating = False ’关闭屏幕更新，加快运行速度
Set wb = ThisWorkbook.Worksheets(1) '定义代码所在工作簿的变量
取得所在文件夹的第一个excel文件名
循环语句
’判断该文件是否是代码所在工作簿
Set rng = wb.Range("A1048576").End(xlUp).Offset(1, 0) '取得所要汇总的工作簿的A列第一个非空单元格
Set wb1 = Workbooks.Open(z) ’打开其他的工作簿
开始复制其他工作簿的内容到指定位置。此处的单元格B6可以替换成自己想要的位置。
wb1.Close False ’关闭其它工作簿
f = Dir '取得下一个文件名
Loop '执行循环
Application.ScreenUpdating = True ’打开屏幕更新
End Sub下载本文
