|
|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub gzt()
'定义记录单所在表格区域的单元格引用
Dim var1, var2 As String
var1 = InputBox("请输入工资记录单的左上角的单元格引用")
ActiveSheet.Range(var1).Select
var2 = InputBox("请输入工资记录单的右下角的单元格引用")
ActiveSheet.Range(var2).Select
ActiveSheet.Range(var1 & ":" & var2).Select
If MsgBox("将所选择区域作为工资记录单吗 ?", vbYesNo, "提示信息") = vbNo Then
Exit Sub
End If
'取得记录单行列坐标
Dim x, y, i, j As Integer
x = Range(var1).Column
i = Range(var1).Row
y = Range(var2).Column
j = Range(var2).Row
'生成工资条
Worksheets("工资条").Cells.Clear
Worksheets("工资条").Activate
'定义循环变量
Dim m, n As Integer
'定义变量k,作为工资条间隔行数的控制器
Dim k As Integer
k = 1
'记录单有多少条记录就循环多少次
For m = 1 To (j - i)
'记录单有多少列就循环多少次
For n = 1 To (y - x + 1)
Worksheets("工资条").Cells(m + k, n) = Worksheets("工资表").Cells(i, x + n - 1)
Worksheets("工资条").Cells(m + k + 1, n) = Worksheets("工资表").Cells(i + m, x + n - 1)
Next
'设置工资条边框格式
Range(Cells(m + k, 1), Cells(m + k + 1, y - x + 1)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlDash
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlDash
.Weight = xlThin
End With
'默认空两行
k = k + 3
Next
Worksheets("工资条").Cells.EntireColumn.AutoFit
End Sub
[ 本帖最后由 panison 于 2009-2-19 19:54 编辑 ] |
|
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2009-2-19 19:41
楼主
不客气!好用就行! 代码感觉比较罗嗦，哪位优化一下，我先谢了！
