LAN-PRO

11月

18日,

2022年

Excel VBAを始めるには（013）

[12]で作成した、乱数発生の一覧表500セルの集計一覧表の作成です。
1-99/100-199/200-299・・・・10分類を、列に集計・一覧にします。
[12]の応用で、別のセルに集計する手法で、Sheetでの関数操作では大変です。
こんな場合はVBAが強みを発揮します。

以下、そのSource

’---------------------------------------------------------------------
Sub Syukei01()
'
' Syukei01 Macro
'
' セルの内容を一定区分で集計します

Dim i, j As Integer
'Dim Cnt_n As Integer

' 集計用のカウンター用変数
Dim C100_n, C200_n, C300_n, C400_n, C500_n, C600_n, C700_n, C800_n, C900_n, C1000_n As Integer

Sheets("Sheet3").Select

Call Syukei_Cls '集計一覧のデータの初期化　プロシージャを呼ぶ

C100_n = 2 'カウンター変数を座標用数値に
C200_n = 2
C300_n = 2
C400_n = 2
C500_n = 2
C600_n = 2
C700_n = 2
C800_n = 2
C900_n = 2
C1000_n = 2

For i = 1 To 25
For j = 1 To 20

Cel_n = Val(Cells(i, j)) 'セルの値を数値化する

Cells(i, j).Select

Select Case Cel_n 'ここでセルの値を識別

Case 1 To 99

Cells(C100_n, 22) = Cells(i, j) 'セルの内容を区分された列に追加

C100_n = C100_n + 1 ' 座標をプラス

Case 100 To 199

Cells(C200_n, 23) = Cells(i, j)

C200_n = C200_n + 1

Case 200 To 299

Cells(C300_n, 24) = Cells(i, j)

C300_n = C300_n + 1

Case 300 To 399

Cells(C400_n, 25) = Cells(i, j)

C400_n = C400_n + 1

Case 400 To 499

Cells(C500_n, 26) = Cells(i, j)

C500_n = C500_n + 1

Case 500 To 599

Cells(C600_n, 27) = Cells(i, j)

C600_n = C600_n + 1

Case 600 To 699

Cells(C700_n, 28) = Cells(i, j)

C700_n = C700_n + 1

Case 700 To 799

Cells(C800_n, 29) = Cells(i, j)

C800_n = C800_n + 1

Case 800 To 899

Cells(C900_n, 30) = Cells(i, j)

C900_n = C900_n + 1

Case Else

Cells(C1000_n, 31) = Cells(i, j)

C1000_n = C1000_n + 1

End Select

Next j
Next i

'
End Sub
'-----------------------------------------------------------------------
Sub Syukei_Cls()
'
' Syukei_Cls Macro
'

'
Range("V2:AE100").Select
Selection.ClearContents

End Sub

わかお　かずまさ

VegaSystems

📷📷📷📷📷📷
#LAN_PRO
#Bloguru

#kuma

11月

18日,

2022年

今日の日の出(2022.11.18)😄

地平線に霞があり遠景がききません。
昨日は社外にあった観葉植物の屋内取り込み、勝手口のクロージャーの交換など
本業以外で時間をとられました。

明日は最後の柿の収穫の予定・・・・

わかお　かずまさ

VegaSystems

📷📷📷📷📷📷
#LAN_PRO
#Bloguru
#kuma_ichinomiya
#VegaSystems
#photography_Ichinomiya
#OM_D_E_M1X
#sunrise_ichinomiya
#Sunset_ichinomiya
#日の出_一宮
#夜明け_一宮

#kuma

11月

18日,

2022年

Excel VBAを始めるには（012）

今回は、セルの値に応じた色での塗りつぶしです。

まず、セルを乱数を発生させた値で埋めます。

次が本番、このセルの値を読み込み、該当する色で
塗りつぶします。

意外に簡単なプログラむです。

以下、Source

Sub RANSU_01()
'
' RANSU_01 Macro
' 乱数を発生させる

Dim i, j As Integer

Dim Cnt_n As Integer

Sheets("Sheet3").Select

For i = 1 To 25
For j = 1 To 20

' 乱数を1-999の間で発生させる

Cnt_n = Int((999 - 1 + 1) * Rnd + 1)

Cells(i, j) = Cnt_n

Next j
Next i

'

'
End Sub
'--------------------------------------------------
Sub Color_01()
'
' Color_01 Macro
'
' セルの数値に応じて塗りつぶしの色を変える

Dim i, j As Integer

Dim Cel_n As Integer

Sheets("Sheet3").Select

For i = 1 To 25
For j = 1 To 20

Cel_n = Val(Cells(i, j)) 'セルの値を数値化する

Cells(i, j).Select

With Selection.Interior 'With から End Withまでは色を付ける命令
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic

Select Case Cel_n 'ここでセルの値を判定し、色を指定する

Case 1 To 99
.ColorIndex = 3

Case 100 To 199
.ColorIndex = 4

Case 200 To 299
.ColorIndex = 5

Case 300 To 399
.ColorIndex = 6

Case 400 To 499
.ColorIndex = 7

Case 500 To 599
.ColorIndex = 8

Case 600 To 699
.ColorIndex = 9

Case 700 To 799
.ColorIndex = 10

Case 800 To 899
.ColorIndex = 43

Case Else
.ColorIndex = 44

End Select

.TintAndShade = 0
.PatternTintAndShade = 0

End With

Next j
Next i

End Sub

わかお　かずまさ

VegaSystems

📷📷📷📷📷📷
#LAN_PRO
#Bloguru

#kuma