Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 6539|回复: 23

[已解决]求添加表格线代码(出现新问题)

[复制链接]
发表于 2014-5-20 11:10 | 显示全部楼层 |阅读模式
本帖最后由 dyzx 于 2014-5-22 09:57 编辑

如果将表1做成表2的效果,代码应该怎样写(即从第二行开始加边框线,学生人数不固定,可以增加或减少,自动加边框线),多谢各位老师指教。
最佳答案
2014-5-20 11:37
  1. Sub demo1()
  2.     Dim lLastrow&
  3.     lLastrow = Cells(Rows.Count, 1).End(xlUp).Row
  4.     If lLastrow > 2 Then
  5.         With Range("a2:c" & lLastrow).Borders
  6.             .LineStyle = xlContinuous
  7.         End With
  8.         With Range("a1")
  9.             .CurrentRegion.HorizontalAlignment = xlCenter
  10.             .Resize(, 3).HorizontalAlignment = xlCenterAcrossSelection
  11.             .CurrentRegion.EntireColumn.AutoFit
  12.         End With
  13.     End If
  14. End Sub
复制代码

表格线.rar

6.35 KB, 下载次数: 15

发表于 2014-5-20 11:18 | 显示全部楼层
条件格式就可以完成,如果你不会VBA就用条件格式吧
回复

使用道具 举报

 楼主| 发表于 2014-5-20 11:23 | 显示全部楼层
youfang 发表于 2014-5-20 11:18
条件格式就可以完成,如果你不会VBA就用条件格式吧

如果用VBA代码怎样写?请指教,多谢。
回复

使用道具 举报

发表于 2014-5-20 11:29 | 显示全部楼层
录一个添加表格线的宏。剩下的修改就OK了。
回复

使用道具 举报

发表于 2014-5-20 11:31 | 显示全部楼层
录制一个宏  未修改
  1. Sub 宏1()
  2.     On Error Resume Next
  3.     Range("A1:C1").Merge
  4.     Range("A2").Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1, 3).Select
  5.     '    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
  6.     '    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  7.     '    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  8.     With Selection.Borders(xlEdgeLeft)
  9.         .LineStyle = xlContinuous
  10.         .ColorIndex = 0
  11.         .TintAndShade = 0
  12.         .Weight = xlThin
  13.     End With
  14.     With Selection.Borders(xlEdgeTop)
  15.         .LineStyle = xlContinuous
  16.         .ColorIndex = 0
  17.         .TintAndShade = 0
  18.         .Weight = xlThin
  19.     End With
  20.     With Selection.Borders(xlEdgeBottom)
  21.         .LineStyle = xlContinuous
  22.         .ColorIndex = 0
  23.         .TintAndShade = 0
  24.         .Weight = xlThin
  25.     End With
  26.     With Selection.Borders(xlEdgeRight)
  27.         .LineStyle = xlContinuous
  28.         .ColorIndex = 0
  29.         .TintAndShade = 0
  30.         .Weight = xlThin
  31.     End With
  32.     With Selection.Borders(xlInsideVertical)
  33.         .LineStyle = xlContinuous
  34.         .ColorIndex = 0
  35.         .TintAndShade = 0
  36.         .Weight = xlThin
  37.     End With
  38.     With Selection.Borders(xlInsideHorizontal)
  39.         .LineStyle = xlContinuous
  40.         .ColorIndex = 0
  41.         .TintAndShade = 0
  42.         .Weight = xlThin
  43.     End With
  44.     Columns("A:C").EntireColumn.AutoFit
  45. End Sub
复制代码
回复

使用道具 举报

发表于 2014-5-20 11:32 | 显示全部楼层
  1. Sub demo1()
  2.     Dim lLastrow&
  3.     lLastrow = Cells(Rows.Count, 1).End(xlUp).Row
  4.     If lLastrow > 2 Then
  5.         With Range("a2:c" & lLastrow).Borders
  6.             .LineStyle = 1
  7.         End With
  8.     End If
  9. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2014-5-20 11:32 | 显示全部楼层
hwc2ycy 发表于 2014-5-20 11:29
录一个添加表格线的宏。剩下的修改就OK了。

本人对VBA知识有限,不知道录制后怎样修改,请老师指教,多谢。
回复

使用道具 举报

发表于 2014-5-20 11:37 | 显示全部楼层
修改后代码:
  1. Sub 宏1()
  2.     On Error Resume Next  '忽略错误
  3.     Range("A1:C1").Merge  'A1:C1合并单元格
  4.     Range("A2").Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1, 3).Select
  5.     Selection.Borders.LineStyle = xlContinuous  '添加边框线
  6.     Columns("A:C").EntireColumn.AutoFit  'A:C自动调整列宽
  7. End Sub
复制代码

评分

参与人数 1 +2 收起 理由
dyzx + 2 很给力!

查看全部评分

回复

使用道具 举报

发表于 2014-5-20 11:37 | 显示全部楼层    本楼为最佳答案   
  1. Sub demo1()
  2.     Dim lLastrow&
  3.     lLastrow = Cells(Rows.Count, 1).End(xlUp).Row
  4.     If lLastrow > 2 Then
  5.         With Range("a2:c" & lLastrow).Borders
  6.             .LineStyle = xlContinuous
  7.         End With
  8.         With Range("a1")
  9.             .CurrentRegion.HorizontalAlignment = xlCenter
  10.             .Resize(, 3).HorizontalAlignment = xlCenterAcrossSelection
  11.             .CurrentRegion.EntireColumn.AutoFit
  12.         End With
  13.     End If
  14. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
dyzx + 3

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2014-5-20 14:44 | 显示全部楼层
如果用下列一段代码请问有何问题,应该怎样修改代码,多谢老师指教。
Sub 设置班级格式()
  Dim ws As Worksheet
  For Each ws In Worksheets
    If ws.Name Like "*班" Then
      With ws
        With .Range("a1").CurrentRegion
          .Borders.LineStyle = xlContinuous
          .HorizontalAlignment = xlCenter
          .VerticalAlignment = xlBottom
        End With
        With .Range("a1")
          .RowHeight = 25
          .Font.Name = "黑体"
          .Font.Size = 16
        End With
        With .Range("a2:c2")
          .RowHeight = 20
          .Font.Name = "黑体"
          .Font.Size = 13
        End With
        .Columns("A:C").EntireColumn.AutoFit
        With .PageSetup
        .FitToPagesWide = 1        
        .FitToPagesTall = 1         
        End With
      End With
    End If
  Next
End Sub
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 01:30 , Processed in 0.389293 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表