SubzsDrawDiagonalLine()Dim ws1 AsWorksheetDim tRng AsRangeDim allRng AsRangeDim i AsLong, j AsLong, k AsLongSet ws1 =Worksheets("data1")With ws1Set allRng = .Range("A2:G30") allRng.Borders(xlDiagonalUp).Weight = xlThinEndWithEnd Sub
Subtest01()Dim ws1 AsWorksheetDim rngStr AsString rngStr ="A2:G30"Set ws1 =Worksheets("data1")Call zfDrawDiagonalLine(ws1, rngStr)End SubFunctionzfDrawDiagonalLine(ByRef ws As Worksheet, ByVal rngSrr As String)Dim i AsLong, j AsLong, k AsLongDim allRng AsRangeSet allRng = ws.Range(rngSrr) allRng.Borders(xlDiagonalUp).Weight = xlThinEnd Function
空白と0のセルだけに斜線を引く
SubzsDrawBlankDiagonalLine()Dim ws1 AsWorksheetDim tRng AsRangeDim allRng AsRangeDim i AsLong, j AsLong, k AsLongSet ws1 =Worksheets("data1")With ws1Set allRng = .Range("A2:G30")For i =1To allRng.Rows.CountFor j =1To allRng.Columns.CountIfallRng(i, j) =""OrallRng(i, j) =0Then .Range(allRng(i, j).Address).Borders(xlDiagonalUp).Weight = xlThinEnd IfNext jNext iEndWithEnd Sub
Subtest03()Dim ws1 AsWorksheetDim rngStr AsStringSet ws1 =Worksheets("data1") rngStr ="A2:G30"Call zfDrawBlankDiagonalLine(ws1, rngStr)End SubSubzfDrawBlankDiagonalLine(ByRef ws As Worksheet, ByVal rngSrr As String)Dim allRng AsRangeDim i AsLong, j AsLong, k AsLongWith wsSet allRng = .Range(rngSrr)For i =1To allRng.Rows.CountFor j =1To allRng.Columns.CountIfallRng(i, j) =""OrallRng(i, j) =0Then .Range(allRng(i, j).Address).Borders(xlDiagonalUp).Weight = xlThinEnd IfNext jNext iEndWithEnd Sub
斜線を消す
SubzsDelDiagonalLine()Dim ws1 AsWorksheetDim tRng AsRangeDim allRng AsRangeDim i AsLong, j AsLong, k AsLongSet ws1 =Worksheets("data1")With ws1Set allRng = .Range("A2:G30") allRng.Borders(xlDiagonalUp).LineStyle = xlNoneEndWithEnd Sub
Subtest02()Dim ws1 AsWorksheetDim rngStr AsStringSet ws1 =Worksheets("data1") rngStr ="A2:G30"Call zfDelDiagonalLine(ws1, rngStr)End SubFunctionzfDelDiagonalLine(ByRef ws As Worksheet, ByVal rngSrr As String)Dim i AsLong, j AsLong, k AsLongDim allRng AsRangeSet allRng = ws.Range(rngSrr) allRng.Borders(xlDiagonalUp).LineStyle = xlNoneEnd Function
選択したセル内の空白と0のセルのみに斜線をひく(消す)
'選択範囲内の空白とゼロのセルのみに斜線をひく(5000個まで)SubmyDrawBlankDiagonalLine()Dim c AsRangeDim n AsLongForEach c In ActiveWindow.RangeSelectionIf c.Value =""Or c.Value =0Then c.Borders(xlDiagonalUp).Weight = xlThin n = n +1If n =5000ThenMsgBox"処理セルが5000回を超えました"Exit ForEnd IfEnd IfNext cEnd Sub'選択範囲のセルの斜線を消すSubmyDelDiagonalLine() ActiveWindow.RangeSelection.Borders(xlDiagonalUp).LineStyle = xlNoneEnd Sub
コメント