| |
▼さぶちゃん さん：
こんにちは。
結果を見てください。後で修正しましょう。
Sub TEST34()
Dim i As Long
Dim eR As Long
Dim vA As Variant
Dim ary As Variant
ary = Array("No.", "氏名", "最高点", "中間点1", "中間点2", _
"中間点3", "最小点", "合計")
With Worksheets(3)
With .Range("I1").CurrentRegion
' 初期化
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Interior.ColorIndex = xlNone
.ClearContents
End With
' データセット
.Range("A1").CurrentRegion.Copy .Range("I1")
.Range("I1").Resize(, 8).Value = ary
eR = .Range("I" & Rows.Count).End(xlUp).Row
' 書式設定
' 外枠
With .Range("I1").CurrentRegion
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
End With
' 一行目の区切り
With .Range("I1:P1").Borders
.Weight = xlThin
.ColorIndex = 1
End With
' P 列の線
With .Range("P2:P" & eR).Borders
.Weight = xlThin
.ColorIndex = 1
End With
' 列のソートと合計
For i = 2 To eR
.Range(.Cells(i, 11), .Cells(i, 15)).Sort _
Key1:=Range("K" & i), Order1:=xlDescending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlLeftToRight, SortMethod:=xlPinYin
.Cells(i, 16).Value = Application.Sum(.Range(.Cells(i, 12), .Cells(i, 14)))
Next
' 書式設定 列の色
.Range("K1:K" & eR).Interior.ColorIndex = 8
.Range("O1:O" & eR).Interior.ColorIndex = 6
' 行のソート .Range("I1").CurrentRegion でもOK
.Range("I1:P" & eR).Sort Key1:=.Range("K1"), Order1:=xlDescending, _
Key2:=.Range("O1"), Order2:=xlDescending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
.Range("I1:P" & eR).Sort Key1:=.Range("P1"), Order1:=xlDescending, _
Key2:=.Range("N1"), Order2:=xlDescending, _
Key3:=.Range("L1"), Order2:=xlDescending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
End With
End Sub
|
|
Yuki
- 08/7/24(木) 17:15 -
