36本目 列の並べ替え

VBA100本ノック

VBA100本ノック 36本目を動画で解説しています。Excelの神髄さんの模範解答はコチラ


問題

#VBA100本ノック 36本目
1行目の見出しの後ろには半角括弧()の中に数値が入っています。
この()括弧内の数値の昇順で列を並べ替えてください。
・全ての列に数値の入った()が正しく最後についています。
・数値は1~3桁の正の整数です。
※非表示列はありません。
※シートは任意

解答

Sub Macro1()
    
    Dim rng As Range
    Set rng = Range("A1").CurrentRegion
    Set rng = Intersect(rng, rng.Offset(1))
    
    ActiveSheet.ChartObjects("グラフ 1").Activate
    ActiveChart.SetSourceData Source:=rng
    ActiveChart.FullSeriesCollection(1).DataLabels.Delete
    ActiveChart.FullSeriesCollection(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 112, 192) '一旦グラフを青に変更
        .Transparency = 0
        .Solid
    End With
    
    Dim MAX_val, MIN_val
    Dim rng_val As Range
    Set rng_val = Intersect(rng, rng.Offset(0, 1))
    MAX_val = WorksheetFunction.Max(rng_val)
    MIN_val = WorksheetFunction.Min(rng_val)
    
    Dim i As Long
    For i = 1 To rng_val.Count
        If Cells(i + 1, 2) = MAX_val Then
            Call グラフの色変更とデータラベル(i, RGB(0, 176, 80)) 'グラフを緑
        ElseIf Cells(i + 1, 2) = MIN_val Then
            Call グラフの色変更とデータラベル(i, RGB(255, 0, 0))  'グラフを赤
        End If
    Next i
    
End Sub

Sub グラフの色変更とデータラベル(i As Long, col As Variant)
    
    ActiveChart.FullSeriesCollection(1).Points(i).Select '受け取った番号
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = col '受け取った色
        .Transparency = 0
        .Solid
    End With
    ActiveChart.SetElement (msoElementDataLabelOutSideEnd)

End Sub
新人君
新人君

すごく実践的な問題ですね!

ブチョ
ブチョ

俺はそうは思わん!

新人君
新人君

なんでやねん…

コメント

タイトルとURLをコピーしました