VBA初心者です。
例えばB列2行目から下に(1)~(7)までの番号を不規則に入力することにより
F列11~17行目に1セルずつ右へ色塗りをしていくにはどうプログラムをかいたらよいでしょうか?
番号によって、色塗りの行と色は決まっています。
(1)→11行目、黄色
(2)→12行目、青色
(3)→13行目、赤色
(4)→14行目、緑色
(5)→15行目、白色
(6)→16行目、黒色
(7)→17行目、茶色
また色塗りはF列からBD列までで終了です。
番号の入力回数の多いものが色塗りを早く終了できることになります。
VBAの本をみながら試行錯誤していましたが、うまくできず…
どなたか詳しい方、お力を貸してください。
No.4ベストアンサー
- 回答日時:
NO2です。
文字列(仮にa~g)の対応例と入力ミスした場合はB列のDeleteでは行を確定できないのでC列に「x」を入力でリセットするようにしています。
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B2:B8")) Is Nothing Then
For Each ap In Target
Select Case ap
Case "a": clr = 6: arow = 0
Case "b": clr = 5: arow = 1
Case "c": clr = 3: arow = 2
Case "d": clr = 4: arow = 3
Case "e": clr = 2: arow = 4
Case "f": clr = 1: arow = 5
Case "g": clr = 9: arow = 6
Case Else: Exit Sub
End Select
For i = 0 To Columns("BD").Column - 6
With Range("F11").Offset(arow, i).Interior
If IsNull(.ColorIndex) Or .ColorIndex < 0 Then
.ColorIndex = clr
Exit For
End If
End With
Next
Next
Else
If Intersect(Target, Range("C2:C8")) Is Nothing Then Exit Sub
For Each ap In Target
If ap = "x" Then
Select Case ap.Offset(0, -1)
Case "a": arow = 0
Case "b": arow = 1
Case "c": arow = 2
Case "d": arow = 3
Case "e": arow = 4
Case "f": arow = 5
Case "g": arow = 6
End Select
For i = Columns("BD").Column - 6 To 0 Step -1
With Range("F11").Offset(arow, i).Interior
If .ColorIndex > 0 Then
.ColorIndex = xlNone
Application.EnableEvents = False
ap.Offset(0, -1).Resize(, 2).ClearContents
Application.EnableEvents = True
Exit For
End If
End With
Next
End If
Next
End If
End Sub
今回も本当にありがとうございます。
文字列入力についてはバッチリ問題のないものでした。
すごいです。助かりました。
ただクリアになった時が"X”入力で、うまく作動せず…。
結果、文字列の入力回数をワークシートのCOUNTIF関数で計算し
その数字分のセルだけ右に色塗りした方がいいのでは?と思い
3/15「VBA 右へ1セルずつ色塗りするには」で再質問させていただきました。
もしよろしければ、そちらでの回答をいただけますと
(かなりずうずうしいですが)大変ありがたく思います。
頼りっぱなしで申し訳ありませんが、よろしくお願いします。
No.3
- 回答日時:
No.1です。
>しかしやってみましたが、上手くいかず…。
とありますので・・・
当方の説明不足だと思います。
もう一度画像をUPしてみます。
今回はダミーではなくB2~B8セルに入れるデータをE列に表示しておきます。
色サンプルは同じ行のB列セルを塗りつぶしておくとして。
Private Sub CommandButton1_Click()
Dim i, j, k As Long
Application.ScreenUpdating = False
For i = 2 To 8
For k = 11 To 17
j = Cells(k, Columns.Count).End(xlToLeft).Column
If Cells(i, 2) = Cells(k, 5) And j <= 55 Then
With Cells(k, j + 1)
.Value = Cells(k, 5)
.Font.ColorIndex = Cells(k, 2).Interior.ColorIndex
.Interior.ColorIndex = Cells(k, 2).Interior.ColorIndex
End With
End If
Next k
Next i
Application.ScreenUpdating = True
End Sub
こんな感じではどうでしょうか?
今回もダメならごめんなさいね。m(_ _)m
今回もありがとうございます。
ただコマンドボタン作成もよくわかっていない初心者のため
有効に使えず…申し訳ありません。
勉強不足です。ありがとうございました。
No.2
- 回答日時:
イベントプロシージャ例です。
対象シートタブ上で右クリック→コードの表示→サンプルコードを貼り付けてお試しください。
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2:B8")) Is Nothing Then Exit Sub
For Each ap In Target
If ap <> "" Or ap > 0 And ap < 8 Then
Select Case ap
Case 1: clr = 6
Case 2: clr = 5
Case 3: clr = 3
Case 4: clr = 4
Case 5: clr = 2
Case 6: clr = 1
Case 7: clr = 9
End Select
ap = ap - 1
For i = 0 To Columns("BD").Column - 6
With Range("F11").Offset(ap, i).Interior
If IsNull(.ColorIndex) Or .ColorIndex < 0 Then
.ColorIndex = clr
Exit For
End If
End With
Next
End If
Next
End Sub
この回答への補足
ありがとうございました。
貼り付けで上手く作動できました。
ただ2点、追加でおききしたいことがあります。
1 Case1~7の入力が数字ではなく文字になった場合、どうしたらよいでしょうか。
文字を別の列で数字におきかえようとしましたが、うまくできませんでした。
2 入力をクリアにした場合、色塗りもクリアにしたい場合は、どうしたらよいでしょうか。
今の状態ですと間違って入力した場合も、カウントされて色塗りになってしまうようです。
申し訳ありませんが、もう少しお力を貸してください。
No.1
- 回答日時:
こんばんは!
一例です。
↓の画像のようにコマンドボタンを配置し、
色サンプルとしてB11~B17セルを塗りつぶしています。
(「白」は判らないので、灰色にしてみました)
ダミー(ストッパー)としてE11~E17セルにデータを入れています。
尚、色付とデータを入れるようにしています(塗りつぶしと同じフォント色)ので
最初からやる場合はデータをDeleteし(ダミーは残す)なおかつ色も消してください。
Private Sub CommandButton1_Click()
Dim i, j, k As Long
For i = 2 To 8
For k = 11 To 17
j = Cells(k, Columns.Count).End(xlToLeft).Column
If Cells(k, j + 1) = "" And j <= 55 Then
If Cells(k, 2) = Cells(i, 2) Then
With Cells(k, Columns.Count).End(xlToLeft).Offset(, 1)
.Value = 1
.Font.ColorIndex = Cells(k, 2).Interior.ColorIndex
.Interior.ColorIndex = Cells(k, 2).Interior.ColorIndex
End With
End If
End If
Next k
Next i
End Sub
こんな感じでどうでしょうか?
他に良い方法があればごめんなさいね。m(_ _)m
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセルのマクロを2つご指南ください 3 2023/01/02 12:16
- Windows 7 エクセルで重複データから抽出したい 2 2022/05/18 23:31
- Excel(エクセル) Excelの列から検索して該当する行を別シートに転記するVBA 2 2022/12/20 09:35
- Excel(エクセル) エクセルで”入力シート”の文字書式の変更を”出力シート”で同じ文字書式で印刷したいです。VBA希望 4 2023/04/24 11:07
- Excel(エクセル) エクセルVBAで次の二つを行いたいのですが思うように動きません。どう修正したらよいのでしょうか? 2 2023/04/22 14:55
- Visual Basic(VBA) エクセルVBAで『A列』に新規で数値を入力し『B列』から右方向の空白セルにその値を貼り付ける方法 4 2022/11/05 08:37
- Visual Basic(VBA) VBAについて教えてください。 Excelで セルのB6~BG24でダブルクリックすると ダブルクリ 1 2022/06/02 17:07
- Visual Basic(VBA) 複数csvを横に追加していくマクロについて 2 2023/04/25 09:19
- Excel(エクセル) 【条件付き書式】countifsで複数条件を満たしたセルを赤くする方法 2 2023/02/09 23:53
- カスタマイズ(車) 駅前のロータリーで、迎えにきたのか路駐待ちの車がたくさんおり、ロータリーに入る手前の車列が道路上で待 3 2023/05/08 20:36
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
複数の文字列のいずれかが含ま...
-
Excelの入力規則で2列表示したい
-
SUMに含まれる範囲から特定のセ...
-
数式が入ったセルを含めて、数...
-
スペースとスペースの間の文字...
-
エクセルで曜日に応じた文字を...
-
Excelで、複数条件で抽出した複...
-
列の数字に100をかけたい
-
エクセルでセルの値分の個数の...
-
エクセル:横長の表を改行して...
-
【Excel】での計算式教え...
-
Excel上でのデータ数字が連番で...
-
エクセル関数に詳しい方教えて...
-
別のセルに値が入力されたら、...
-
エクセルで小数を含む数値の抽出
-
Excelで2tan(π/4-θ)のグラフを...
-
EXCELのハイホン区切りの数字並...
-
Excelのセル内文字の並び替えに...
-
【EXCEL】指定したセルの値を他...
-
時間を「昼間」と「夜間」に分...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
複数の文字列のいずれかが含ま...
-
Excelの入力規則で2列表示したい
-
SUMに含まれる範囲から特定のセ...
-
数式が入ったセルを含めて、数...
-
Excel上でのデータ数字が連番で...
-
列の数字に100をかけたい
-
スペースとスペースの間の文字...
-
別のセルに値が入力されたら、...
-
エクセルで表示されている数字...
-
エクセルでセルの値分の個数の...
-
エクセル:横長の表を改行して...
-
[関数について]わかる方教えて...
-
エクセル関数に詳しい方教えて...
-
エクセルで、毎日の走行距離(...
-
エクセルのsumifでかけ算してか...
-
HYPERLINKとADDRESSとMATCHの組...
-
エクセルで曜日に応じた文字を...
-
入退社日より各月末の在籍者数...
-
エクセルで1列全部10倍したい
-
エクセルで小数を含む数値の抽出
おすすめ情報