ぎょたろう発信の「お得な生活情報」

この広告は30日以上更新がないブログに表示されております。
新規記事の投稿を行うことで、非表示にすることが可能です。

プログラム中の　　◆◆ここの数字を変える　　の数値を変えるだけですぐに使えます！





Sub 違う部屋になったら色を変える()
'
' 違う部屋になったら色を変える Macro
'1 A
'2 B
'3 C
'4 D
'5 E
'6 F
'7 G
'8 H
'9 i
'10 J
'11 K
'12 L
'13 M
'14 N
'15 O
'16 P
'17 Q
'18 R
'19 S
'20 T
'21 U
'22 V
'23 W
'24 x
'25 Y
'26 Z

'　　　セル範囲の例
'セル範囲A1:B3を選択します。
'Sub rei_807()
' Worksheets("Sheet1").Activate
' Range(Cells(1, 1), Cells(3, 2)).Select
'End Sub


'
Dim gyou_no As Integer '最初の行番号
Dim saigo_gyou_no As Integer '最後の行番号
Dim hidari_retsu As Integer '左の列番号
Dim migi_retsu As Integer '右の列番号
Dim color As Integer
Dim sub_name(3) As String


sub_name(1) = "�@色無し"
sub_name(2) = "�A色あり"
sub_name(3) = "�@色無し"


gyou_no = 1 '塗る最初の行番号　◆◆ここの数字を変える　　　最初のセルの行番号
saigo_gyou_no = 16 '塗る最後の行番号　◆◆ここの数字を変える　　　最後のセルの行番号
hidari_retsu = 1 '塗る左の列番号　 ◆◆ここの数字を変える　　　左セルの列番号　1はA
migi_retsu = 6 '塗る右の列番号　　◆◆ここの数字を変える　　　右セルの列番号　6はF

color = 1 '上と下の値が違う時インクリメント 1 は　�@色無し　 2 は　�A色あり　　3 は　�@色無し

Range(Cells(gyou_no, hidari_retsu), Cells(saigo_gyou_no, migi_retsu)).Select '（例）A1からF16選択して全部色無しで塗る

Application.Run sub_name(color) '全部色無しで塗る　　sub_name(1) = "�@色無し"

Range(Cells(gyou_no, hidari_retsu), Cells(gyou_no, migi_retsu)).Select '（例）A1からF1選択
Application.Run sub_name(color) 'とりあえず最初の行を色無しで塗る
gyou_no = gyou_no + 1 '次の行に移動


Do While gyou_no <> saigo_gyou_no + 1

If Cells(gyou_no, hidari_retsu).Value <> Cells(gyou_no - 1, hidari_retsu).Value Then '（例）A2とA1の値が違う時
color = (color + 1) Mod 2 + 2 '�@→�A→�B→�A→�B→�A
End If

Range(Cells(gyou_no, hidari_retsu), Cells(gyou_no, migi_retsu)).Select '一行選択
Application.Run sub_name(color) '前と違う時はcolorがインクリメントされた色で塗る

gyou_no = gyou_no + 1
Loop

End Sub
Sub �@色無し()
'
' 色無し Macro　　　セルの色を塗るマクロからコピーしてきた
'

'
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Sub �A色あり()
'
' 色あり Macro セルの色を塗るマクロからコピーしてきた

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
End Sub
Sub 消すテスト()
'
' 消す Macro
'
Dim gyou_no As Integer '最初の行番号
gyou_no = 1 'ここの数字を変える

Range(Cells(gyou_no, 1), Cells(gyou_no + 15, 6)).Select 'A1からF16選択

With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With

End Sub


車のカテゴリーも見てね！





あると便利な車グッズ集
　　　　　　　　　　　　　　

楽天1位 送料無料(沖縄・北海道・離島を除く)☆Quickjack ≪クイックジャッキ≫ BL-5000SLX AC（100V） 【Ranger（レンジャー）】カーリフト 価格：153900円（税込、送料無料) (2021/10/30時点)