我在工作簿中有50张。表头范围是A:Z。数据范围因工作表而异。我得到了VBA代码,它在非空单元格上设置了边框,但是数据中的某些字段是空白的。有人可以帮助编写脚本吗?
下面是我尝试修改以应用于所有工作表的代码,徒劳无功:
Sub testborder()
Dim rRng As Range
Set rRng = Sheet1.Range("A14:K14" & endrow)
'Clear existing
rRng.Borders.LineStyle = xlNone
'Apply new borders
rRng.BorderAround xlContinuous
rRng.Borders(xlInsideHorizontal).LineStyle = xlContinuous
rRng.Borders(xlInsideVertical).LineStyle = xlContinuous
End Sub
使用以下代码解决:
Sub AllWorksheetBorders()
Application.ScreenUpdating = False 'Prevents screen refreshing
Dim lngLstCol As Long, lngLstRow As Long, ws As Worksheet
Dim rngCell As Range, r As Long, c As Long
For Each ws In ActiveWorkbook.Worksheets
lngLstRow = ws.UsedRange.Rows.Count
lngLstCol = ws.UsedRange.Columns.Count
For Each rngCell In ws.Range("A21:A" & lngLstRow)
If rngCell.Value <> "" Then
r = rngCell.Row
c = rngCell.Column
With ws.Range(ws.Cells(r, c), ws.Cells(r, lngLstCol)).Borders
.LineStyle = xlContinuous 'Setting style of border line
.Weight = xlThin 'Setting weight of border line
.ColorIndex = xlAutomatic 'Setting colour of border line
End With
End If
Next
Next
Application.ScreenUpdating = True 'Enables screen refreshing
End Sub
答案 0 :(得分:0)
使用以下代码解决:
Sub AllWorksheetBorders()
Application.ScreenUpdating = False 'Prevents screen refreshing
Dim lngLstCol As Long, lngLstRow As Long, ws As Worksheet
Dim rngCell As Range, r As Long, c As Long
For Each ws In ActiveWorkbook.Worksheets
lngLstRow = ws.UsedRange.Rows.Count
lngLstCol = ws.UsedRange.Columns.Count
For Each rngCell In ws.Range("A21:A" & lngLstRow)
If rngCell.Value <> "" Then
r = rngCell.Row
c = rngCell.Column
With ws.Range(ws.Cells(r, c), ws.Cells(r, lngLstCol)).Borders
.LineStyle = xlContinuous 'Setting style of border line
.Weight = xlThin 'Setting weight of border line
.ColorIndex = xlAutomatic 'Setting colour of border line
End With
End If
Next
Next
Application.ScreenUpdating = True 'Enables screen refreshing
End Sub