抛砖引玉----自己编的小宏

3rElejGc.rar (10.53 KB, 下载次数: 42)

这是我自己不断摸索编的小宏，从不知道到知道，可能对一些想要学习编宏的比较有用。代码很简单，适合初学者。

Sub 边框() Dim i, n

Range("b1").Formula = "=counta(r[1])" i = Range("b1").Value

For n = 1 To (i - 1) / 3

Range(Cells(3, n * 3 - 1), Cells(17, n * 3 + 1)).Select 加边框 Range(Cells(1, n * 3 - 1), Cells(2, n * 3 + 1)).Select 加边框

Next n Range("a1:a2,a3:a17").Select 加边框 Range("b1").Clear End Sub

Sub 加边框() rem 这里完全是录的，对于初学者录宏是一个很好的学习的方法。

With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous '.Weight = xlThin '.ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous '.Weight = xlThin '.ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous '.Weight = xlThin '.ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous '.Weight = xlThin '.ColorIndex = xlAutomatic End With Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

End Sub

我写的，好像比楼主的更麻烦一点，呵呵

Sub hjs() Dim irow%, icol%, j%

Application.ScreenUpdating = False With Range("a2").CurrentRegion irow = .Rows.Count '当前区域行的总数 icol = .Columns.Count '当前区域列的总数 .Borders.LineStyle = xlNone '清除当前区域所有的边框 End With

Add_border Cells(1, 1).Resize(2, 1) '增加a1：b1的边框 Add_border Cells(3, 1).Resize(irow - 2, 1) '增加a3和下面单元格的边框 For j = 2 To icol Step 3 '每3列循环一次，增加边框 Add_border Cells(1, j).Resize(2, 3) Add_border Cells(3, j).Resize(irow - 2, 3) Next End Sub

Sub Add_border(rng As Range) '加边框，上下左右四边 With rng .Borders(xlEdgeLeft).LineStyle = xlContinuous '左 .Borders(xlEdgeTop).LineStyle = xlContinuous '上 .Borders(xlEdgeBottom).LineStyle = xlContinuous '下 .Borders(xlEdgeRight).LineStyle = xlContinuous '右 End With End Sub

加边框的代码可精简为： selection.Borders.LineStyle = xlContinuous

关于楼主i的使用，可以直接这样。

i = Application.WorksheetFunction.CountA(Rows(2))

调用工作表函数counta

weight或linestyle默识是加四边框，不管指定线条样式或线宽都会加上四周框线

有兴趣可测试下面程式码：

Sub xx() [d3].Borders.Weight = xlMedium [d5].Borders.LineStyle = xlContinuous [d7].Borders.Weight = xlThin [d9].Borders(1).Weight = xlMedium [d11].Borders(2).Weight = xlMedium [d13].Borders(3).Weight = xlMedium [d15].Borders(4).Weight = xlMedium [d17].Borders(5).Weight = xlMedium End Sub

我写的，好像比楼主的更麻烦一点，呵呵

太谦虚了，LONGIII兄，，

[em04]

不过3、4楼的语句一定记下！！！

录制宏的效率是很低，要学会怎么修改代码！

经常来论坛学习，慢慢就知道怎么提速了