预期效果
Stata控制行业、年份回归,导出到Excel后,会生成很多很多行年份、行业的虚拟变量,需要手动调整格式,删除很多很多行才能复制粘贴到论文中,对于经常跑回归的人来说,一次一次重复很浪费时间,于是我利用Excel宏功能设置了条自动整理格式的宏。
【宏运行前】
【宏运行后】
实现过程
相信学过计量使用Stata的都知道如何从Stata输出多个回归结果到Excel:
reg y1 x1 x2 x3 x4 ...... xn i.Ind2 i.year
est store res1
reg y1 x1 x2 x3 x4 ...... xn i.Ind2 i.year
est store res2
reg y1 x1 x2 x3 x4 ...... xn i.Ind2 i.year
est store res3
reg y1 x1 x2 x3 x4 ...... xn i.Ind2 i.year
est store res4
outreg2 [res1 res2 res3 res4] using auditorreturn1,tstat e(r2_a,F) bdec(3) tdec(2) excel replace
下面开始在Excel中进行宏操作:
可将整个过程拆解成五步
第一步,录制一个处理表头的宏,主要操作包括删除不必要的行,设置边框,图中高亮处为光标初始定位点。
下面代码是录制宏时VBA窗口自动生成的代码,后面将基于此段代码进行改写,这样做相比于直接写代码要容易上手。
Sub 宏3()
'
' 宏3 宏
Range("A3:E3").Select
Selection.Delete Shift:=xlUp
Range("A4:E4").Select
Selection.Delete Shift:=xlUp
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A4").Select
End Sub
第二步,打开第一步录制宏的VBA窗口,将单元格默认的绝对引用改成相对引用,再写三行简单的代码将活动单元格从表头移动到后面行业虚拟变量2.Ind2处(即上图中第2个高亮处),改完的代码如下:
Sub 宏1()
'
' 宏1 宏
ActiveCell.Range("A1:E1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Range("A2:E2").Select
Selection.Delete Shift:=xlUp
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveCell.Range("A1").Select
Do While ActiveCell.Range("A1") <> "2.Ind2"
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
End Sub
第三步,录制一个连续删除行的宏,打开VBA窗口,将刚刚生成删除行的代码改写一个循环,修改后的代码如下。
Sub Stata输出正式整理()
Do While ActiveCell.Range("A1") <> "Constant"
ActiveCell.Range("A1:E1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Range("A1").Select
Loop
ActiveCell.Range("A1:E1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Range("A1").Select
End Sub
该代码实现的功能是从给定的初始位置删除行,直到删除第一个单元格的内容是“Constant”。(即上图中第三个高亮处)
第四步,在第三步的基础上再写几行代码,在“Constant”后面两行写上控制行业和年份等内容。新增的代码如下:
ActiveCell.Range("A1") = "控制行业"
ActiveCell.Range("A2") = "控制年份"
ActiveCell.Range("B1") = "Y"
ActiveCell.Range("B2") = "Y"
ActiveCell.Range("C1") = "Y"
ActiveCell.Range("C2") = "Y"
ActiveCell.Range("D1") = "Y"
ActiveCell.Range("D2") = "Y"
ActiveCell.Range("E1") = "Y"
ActiveCell.Range("E2") = "Y"
第五步,最后将第二、三、四步中的代码拼接起来,即实现整个功能。可以点击开发工具里面的宏运行,也可以设置快捷键运行,还可以设置控件按钮通过按钮进行。
最终整理后代码如下:
Sub Stata输出正式整理()
'
' 宏2 宏
'
ActiveCell.Range("A1:E1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Range("A2:E2").Select
Selection.Delete Shift:=xlUp
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveCell.Range("A1").Select
Do While ActiveCell.Range("A1") <> "2.Ind2"
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
Do While ActiveCell.Range("A1") <> "Constant"
ActiveCell.Range("A1:E1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Range("A1").Select
Loop
ActiveCell.Range("A1:E1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Range("A1").Select
ActiveCell.Range("A1") = "控制行业"
ActiveCell.Range("A2") = "控制年份"
ActiveCell.Range("B1") = "Y"
ActiveCell.Range("B2") = "Y"
ActiveCell.Range("C1") = "Y"
ActiveCell.Range("C2") = "Y"
ActiveCell.Range("D1") = "Y"
ActiveCell.Range("D2") = "Y"
ActiveCell.Range("E1") = "Y"
ActiveCell.Range("E2") = "Y"
End Sub