こんにちは。
マクロ初心者です。
現在マクロを書いていて、ちょっと困ったことがありました。
初心者なのでネットで調べたり、以前こちらにも質問させて頂いたりしてやっと出来たのですが・・・。
現在やりたいことはSheet2に数字を入れるとSheet1のセルの色が変わるようにしています。
1~15までの数字にそれぞれカラー設定して数字を入力すると思ったようにSheet1のセルの色が変わるのですが、今後使用していくにあたって
データを値貼り付けするということです。
値貼り付けだとマクロが走りません。
何か良い方法はありますか?
ちなみにこちらが問題のマクロです。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim IColor As Integer
Dim R As Range
For Each R In Target
Select Case R
Case "1"
IColor = 56
Case "2"
IColor = 16
Case "3"
IColor = 13
Case "4"
IColor = 39
Case "5"
IColor = 17
Case "6"
IColor = 37
Case "7"
IColor = 41
Case "8"
IColor = 11
Case "9"
IColor = 10
Case "10"
IColor = 4
Case "11"
IColor = 6
Case "12"
IColor = 46
Case "13"
IColor = 40
Case "14"
IColor = 22
Case "15"
IColor = 26
Case Is >= 16
IColor = 3
End Select
Next
i = Target.Row
Worksheets("Sheet1").Range("B3:F7").Cells(i - 3).Interior.ColorIndex = IColor
End Sub
モジュールですとマクロ実行で走りますが、Private Subの場合で値貼り付けで走る方法などありますか?
また、もし書いたマクロが違うようであれば手直しなど一緒にして頂けると助かります。
どなたか詳しい方宜しくお願い致します。
A 回答 (10件)
- 最新から表示
- 回答順に表示
No.10
- 回答日時:
本当に、たびたびすみません。
出来たと思った瞬間に、気が緩んでしまいました。
>Elseだったところを
>ElseIf>=16Thenに直しましたがコンパイルエラーが出てしまいました。。
ElseIf i >= 16 Then
iが抜けていました。
No.9
- 回答日時:
こんばんは。
>値貼り付けした時に0の部分も色が塗られてしまうんです・・・。
失礼しました。元のコードが、
Case Is >= 16
IColor = 3
となっていましたね。それを読み落としていました。
私のコードの中の、
-----------------------------------
ReDim ar(CellCnt - 1)
For Each c In Target
If c.Value <> "" Then
If IsNumeric(c.Value) Then
i = c.Value
-------------------------------------
の下の部分を以下のように書き換えれば良いはずです。
If i > 0 And i < 16 Then
j = iColors(i - 1)
ElseIf >= 16 Then '←変更
j = 3
End If
今は、コードを動かしてはいませんが、間違いないと思っています。それで、とりあえず試してみてください。
この回答への補足
早急な対応ありがとうございます。
Elseだったところを
ElseIf>=16Thenに直しましたがコンパイルエラーが出てしまいました。。
何度もお手数をおかけして本当に心苦しいのですが、どのようにしたら良いでしょうか(/_;)
No.8
- 回答日時:
こんばんは。
確約を取らずに作ってしまいました。
2点の、それぞれのセルの色が変わること。3列を埋めるけれども、3列に満たない場合は、途中で終わるという考え方です。以下のコードからダウンサイジングは簡単です。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iColors As Variant
Dim rw As Long
Dim CellCnt As Integer
Dim col As Integer
Dim col2 As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim c As Variant
Dim ar() As Variant
Dim Sh1 As Worksheet
Set Sh1 = Worksheets("Sheet1")
col = Target.Cells(1).Column
'制限された列
If Not (col = 2 Or col = 5 Or col = 8 Or col = 11) Then Exit Sub
iColors = Array(56, 16, 13, 39, 17, 37, 41, 11, 10, 4, 6, 46, 40, 22, 26)
CellCnt = Target.Count
ReDim ar(CellCnt - 1)
For Each c In Target
If c.Value <> "" Then
If IsNumeric(c.Value) Then
i = c.Value
If i > 0 And i < 16 Then
j = iColors(i - 1)
Else
j = 3
End If
ar(k) = j
k = k + 1
End If
End If
Next c
rw = Target.Row
Select Case col
Case 2: col2 = 1
Case 5: col2 = 5
Case 8: col2 = 9
Case 11: col2 = 13
'Sh1.Cells(rw + 2, 13).Resize(Int(Target.Count / 3), 3).Interior.ColorIndex = j
End Select
InsideColors Sh1, rw, col2, CellCnt, ar()
Set Sh1 = Nothing
End Sub
Private Sub InsideColors(sh As Worksheet, _
rw As Long, _
col As Integer, _
cnt As Integer, _
ar As Variant)
'sh[シート],rw[行], col[列],cnt[セル個数],iColor[色指数]
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim k As Integer
If cnt Mod 3 > 0 Then '範囲行数
i = (cnt + 3 - (cnt Mod 3)) / 3
Else
i = cnt / 3
End If
rw = Int((rw - 1) / 3) + 1 '行再設定
j = ((rw - 1) Mod 3) + 1 '列設定
For n = j To cnt
sh.Cells(rw + 2, col).Resize(i, 3).Cells(n).Interior.ColorIndex = ar(k)
k = k + 1
Next n
End Sub
この回答への補足
こんばんは。
マクロありがとうございました。
完璧に動いて感動ものです。
ただ、一点今日気づいたのですがSheet2へ値貼り付けするとSheet1のセルがそれぞれ色が変わりますよね?
Sheet2のA1:A9へ値貼り付けした際に
A1=1
A2=3
A3=4
A4=0
A5=0
A6=2
A7=1
A8=0
A9=1
と値貼り付けした時に0の部分も色が塗られてしまうんです・・・。
自分でも何とかしようと頑張ってみたのですが、イマイチ分からず。。。
何度も申し訳ないのですが、このような場合頂いたマクロをどのように書き換えればいいのでしょう(;_;)
ご連絡が遅くなりすみません。
やりたいことを完璧に理解してくださり、また完璧なコードを書いていただきましてありがとうございます☆
本当に感謝しています。ありがとうございました。
メールでしかお礼を言えないのが残念なくらいです。。
明日会社へ行って早速試してみます。
No.7
- 回答日時:
こんにちは。
補足を読みました。発想がユニークで、とても面白いです。
ただ、これは、ちょっと、ひとひねり考えないといけませんね。もし、私の予想があっていれば、これは簡単ではありませんね。
コードを書いてみて、2点ほどが疑問に残りました。
・それぞれのセルは別々の色が付くのではありませんか?
・それと、もしかしたら、セルの枡を一つずつ埋めていくというものではないでしょうか?
つまり、こういうことです。
>Sheet2のB1:B9に値貼り付けをするとSheet1のA3:C5の色が変更
この場合は、9個のセルだから、3 × 3 が成立しますが、
8個の場合は、A3 ~B5 の8セル?
A3 B3 C3
A4 B4 C4
A5 B5
8個だと、4角形になりません。
それで、次に、
>Sheet2のB1:B9に値貼り付けをするとSheet1のA3:C5の色が変更
この後に、B10 以降に貼り付けると、Sheet1のC5 に入るという考え方ではないでしょうか?
そんな気がしました。こういう考え方であっているのでしょうか?
今は、こんなことを考えながら進めています。たとえ間違えていても、ここから、レベルダウンするのは楽です。
No.6
- 回答日時:
とりあえず、
>頂いた回答によるとこれでは全体のマクロ構成が違うとの事ですが最初から書き直しでしょうか(;_;)
#全体のマクロの構成自体が違います。
と書いたのは、最後にあるコードが先になるのではないか、と考えたからです。コード自体が別になることではありません。
今回補足でいただいたものを元に何とか、最後までやってみるつもりです。それに、もう一人の回答者の方もいらっしゃることだし、どちらかが先に、iokmuoytさんの満足いけるものが出来れば、それで良いと思います。少し、時間をください。
No.5
- 回答日時:
こんにちは。
#3 の回答者です。
これは、私のところでも、前の#4さんのところに補足しても、質問のポイントは同じですから、どちらでもよいのですが……。
>例えばG1は反映できるのですが、G2とG3も反映させるのは
>どうのようにしたら良いでしょうか?
(^^;、やっぱり! 最初のコードをみて最初からヘンだと思っていたのです。それと、まだヘンな部分がありますね。
実際に、
Worksheets("Sheet1").Range("B3:F7").Cells(i - 3)
というのは、このコードは、1個のセルを塗るということですが、それも、奇妙にも横に動いています。
こういう説明は出来ませんか?
Sheet2 のB3:B5 まで、貼り付けたときに、
Sheet1 のA1:A3 まで、色が塗られるとか。
それから、
"B3:F7"や"G3:H10" というのも、本当は良く分からないのです。
それは、Sheet2 自体の範囲制限、または、Sheet1 自体のイベント・ドリブンの範囲制限ではありませんか?そうすると、全体のマクロの構成自体が違います。
>例えばG1は反映できるのですが、G2とG3も反映させるのは
絵は、横になっていますが、実際は、G1,G2,G3 は、行数ですから、縦です。
こんなところをクリアしていただければ、マクロは完成するはずです。
この回答への補足
再度ご回答頂きましてありがとうございます。
説明が不十分で申し訳ありません。。。
一からきちんと説明しますと、G1~G4という項目があります。
例えば
Sheet2:A列にはG1というグループの施設名9行が入っており、B列に毎月外部から取ってくるデータG1の施設に対するデータを値貼り付けします。
D列にはG2というグループ施設名が15行ありE列は同様外部データを値貼り付け、ということなので
G1:A~B、G2:D~E、G3:G~H、G4:J~K
の列を必要とし、行は項目(G1~G4)によって違います。
外部データをSheet2のB・E・H・Kに値貼り付けすることにより
Sheet1のセルの色を変えたかったのですが
Sheet1はG1が9行あれば3×3のA3:C5の枠を取っています。
G2が15行であれば、3×5のE3:G7でセル設定をしています。
#3の方と#2の方のマクロを参考に値貼り付けまでは完ぺきに出来たのですが、色がつくのはG1の枠のみだけでした。
Sheet2のB1:B9に値貼り付けをするとSheet1のA3:C5の色が変更
Sheet2のE1:E15に値貼り付けをするとSheet1のE3:G7の色が変更
Sheet2のH1:H10に値貼り付けをするとSheet1のI3:K6の色が変更
Sheet2のK1:K6に値貼り付けをするとSheet1のM3:O4の色が変更
これが最終的にやりたかったことですが、全く分からなかったので
一つずつ解決していこうと思っていましが。。。
頂いた回答によるとこれでは全体のマクロ構成が違うとの事ですが
最初から書き直しでしょうか(;_;)
No.4
- 回答日時:
ANo.2です。
ちゃんとfor each r in targetになっているのに、色を変える部分がfor each ~ next の外にあり、i=Target.Rowになっていたので、左上を一度だけになっていたのではないでしょうか。
i = Target.Row
を
i = R.Row
にして、
i = R.Row
Worksheets("Sheet1").Range("B3:F7").Cells(i - 3).Interior.ColorIndex = IColor
を
Next
の前にすれば、質問のプログラムは動くと思います。
追加の分は、Sheet1の黒丸の数がSheet2の下線の数と同じみたいですが、どうするのかがわかりません。
sheet1の
G1
●●●●
●●●●
●●●
と、sheet2の
G1
-----
-----
-----
-----
-----
-----
-----
-----
-----
-----
-----
というのは、どういう意味でしょうか?
もしかしたら動かないプログラムを載せてもらった方がわかるかもしれません。
この回答への補足
ありがとうございます。
#3の方とこちらの方のマクロを組み合わせうまく走りました。
分かりやすく説明までして頂きありがとうございました。
前回補足させて頂いたものですが、
例えば
Sheet2:A列にはG1というグループの施設名9行が入っており、B列に毎月外部から取ってくるデータG1の施設に対するデータを値貼り付けします。
D列にはG2というグループ施設名が15行ありE列は同様外部データを値貼り付け、ということなので
G1:A~B、G2:D~E、G3:G~H、G4:J~K
の列を必要とし、行は項目(G1~G4)によって違います。
外部データをSheet2のB・E・H・Kに値貼り付けすることにより
Sheet1のセルの色を変えたかったのですが
Sheet1はG1が9行あれば3×3のA3:C5の枠を取っています。
G2が15行であれば、3×5のE3:G7でセル設定をしています。
#3の方と#2の方のマクロを参考に値貼り付けまでは完ぺきに出来たのですが、色がつくのはG1の枠のみだけでした。
Sheet2のB1:B9に値貼り付けをするとSheet1のA3:C5の色が変更
Sheet2のE1:E15に値貼り付けをするとSheet1のE3:G7の色が変更
Sheet2のH1:H10に値貼り付けをするとSheet1のI3:K6の色が変更
Sheet2のK1:K6に値貼り付けをするとSheet1のM3:O4の色が変更
これが最終的にやりたかったことですが、全く分からなかったので
一つずつ解決していこうと思っていましたが。。。
No.3
- 回答日時:
こんばんは。
値貼り付けで、このマクロが動かないわけではなくて、おそらく、シートモジュールが別のところに貼り付けてあったりするわけだと思います。この手のマクロを貼り付ける場合は、
画面下のシートタブの所を、右クリック-コードの表示 で、貼り付けていただかないと、意外に間違えていることが多いです。この場合は、[Sheet2]だと思います。
ただ、それはともかく、そのマクロですと、IColor を取るのは、領域の最後の貼り付けのものだけになるわけだと思います。それと、
つまり、i は、領域の先頭であって、
i = Target.Row
Range("B3:F7").Cells(i - 3)
ですから、i >2 でないと、エラーが発生するはずです。
同じものを、私なりに考えてみました。
'-----------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iColors As Variant
Dim i As Integer
Dim j As Integer
iColors = Array(56, 16, 13, 39, 17, 37, 41, 11, 10, 4, 6, 46, 40, 22, 26)
For Each c In Target
If c.Value <> "" Then
If IsNumeric(c.Value) Then
i = c.Value
If i > 0 And i < 16 Then
j = iColors(i - 1)
Else
j = 3
End If
End If
End If
Next c
i = Target.Row
If i > 2 And j > 0 Then
Worksheets("Sheet1").Range("B3:F7").Cells(i - 3).Interior.ColorIndex = j
End If
End Sub
この回答への補足
ご連絡が遅くなり申し訳ございません。
回答ありがとうございました。
とてもきれいな書き方で勉強になり感謝です☆
ただ、一つ値貼り付けではマクロが走らなかったのですが・・・。
私の説明不足でしたが、値貼り付けは複数行あり最初のセルのみ色が変わりました。
また、追加で教えて頂きたいのですが、各Sheetには一つではなく
いくつかのセルがあります。
例)
G1 G2 G3
●●●● ●●● ●●
●●●● ●●● ●●
●●● ●●● ●
このようなSheet1に対してSheet2は
G1 G2 G3
----- ----- ----
----- ----- ----
----- ----- ----
----- ----- ----
----- ----- ----
----- -----
----- -----
----- -----
----- -----
-----
-----
とSheet1のセルの分だけ行があります。
例えばG1は反映できるのですが、G2とG3も反映させるのは
どうのようにしたら良いでしょうか?
頂きましたマクロの("B3:F7")を("G3:H10")に置き換えてみましたがエラーが出ました。
Private Subでは一枚のコードに2つはダメなのでしょうか?
度々すみませんが、ご回答宜しくお願い致します
No.2
- 回答日時:
数字入力では動いているのなら、貼り付けでも動いていると思います。
ただ、複数領域を張り付けた場合、正しく動いていないんではないでしょうか?
左上の1セル分しか実行しないようになっていると思います。
Targetには、貼り付けの時は、まとめてこの領域と値が入って来るんじゃないかと思います。
Application.StatusBar = Target.Address(False, False)
を適当な所に入れて、数字や領域コピーをしてもらえれば、Targetの値がわかると思います。
p.s.
Application.StatusBar = False
をコード内かイミディエイトウインド内で実行すれば、ステータスバーの表示が元に戻ります。
ご回答ありがとうございます。
そうなんです。最初の値は走るんですが、複数貼り付けした場合は残りが走らないんです。。。
また、追加で申し訳ありませんが下記のように同じSheet内に
いくつかのセル設定がある場合
例)
G1 G2 G3
●●●● ●●● ●●
●●●● ●●● ●●
●●● ●●● ●
このようなSheet1に対してSheet2は
G1 G2 G3
----- ----- ----
----- ----- ----
----- ----- ----
----- ----- ----
----- ----- ----
----- -----
----- -----
----- -----
----- -----
-----
-----
どのようにマクロを書いたら良いのでしょうか?
Private Subの場合、同じコード内に同じマクロを書込みセル位置を変えてみたのですがエラーが発生しました。
度々申し訳ありませんが、ご回答お願い致します。
No.1
- 回答日時:
うん?貼り付けてみたけど、イベント自体は動いているんだけど?
貼り付けた場所は、sheet1でOKかな?
イベントを拾うためには、そのイベントの対象となるシートのところに書かないといけない。標準モジュールでは駄目ですよ。
まず、「Worksheets("Sheet1").Range("B3:F7").Cells(i - 3).Interior.ColorIndex = IColor」
の、意図が読めないんだけど、
Sheet1の同じ個所に、Sheet2の結果を反映するなら、
Nextの上に、
「Worksheets("Sheet1").Cells(R.Row,R.Column).Interior.ColorIndex = IColor」とするんじゃないかな。で、NextからEndSubの間を削除。
違ってたらごめん。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Visual Basic(VBA) エクセルのVBAでダブルクリックでチェックを入れたあと 1 2022/10/26 20:30
- Visual Basic(VBA) 【変更】ファイルを閉じてダイアログで保存した時、更新したシートだけの処理の実行をする 5 2022/03/26 18:31
- Visual Basic(VBA) vbaでセルに入力したときに,その横にあるセルを保護し入力不可にするマクロを作りたいです。 2 2022/04/24 20:59
- Visual Basic(VBA) Excelのマクロについて教えてください。 3 2022/06/30 09:36
- Visual Basic(VBA) 【追加】ファイルを閉じてダイアログで保存した時だけ処理の実行をする 3 2022/03/23 15:43
- Visual Basic(VBA) select caseの入れ子 3 2023/03/08 18:48
- Visual Basic(VBA) エクセル VBAについて 2 2022/05/16 16:33
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Excel(エクセル) Excel2019 マクロを使用し画像を貼り付けした際のリンク切れについて 2 2022/11/15 16:14
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
首吊りどこ締めるの
-
至急!尿検査前日にオナニーし...
-
尿検査前日に自慰行為した時の...
-
白血球が多いとどんな心配があ...
-
彼女のことが好きすぎて彼女の...
-
検便についてです。 便は取れた...
-
腕を見たら黄色くなってる部分...
-
勃起する時って痛いんですか? ...
-
尿検査の前日は自慰控えたほう...
-
精子が黄色?
-
中出しをするとお腹が痛い・・・。
-
EXCELで条件付き書式で空白セル...
-
excelでsin二乗のやり方を教え...
-
これって喉仏ですか? 私は女性...
-
口の中に黒い血の塊
-
納豆食べた後の尿の納豆臭は何故?
-
2つの数値のうち、数値が小さい...
-
エクセル指定した範囲からラン...
-
筋トレするとチンコが縮んじゃ...
-
変な話しになります。尿検査で...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
至急!尿検査前日にオナニーし...
-
首吊りどこ締めるの
-
尿検査の前日は自慰控えたほう...
-
尿検査前日に自慰行為した時の...
-
検便についてです。 便は取れた...
-
白血球が多いとどんな心配があ...
-
中出しをするとお腹が痛い・・・。
-
射精をして1週間以内に尿検査を...
-
彼女のことが好きすぎて彼女の...
-
腕を見たら黄色くなってる部分...
-
勃起する時って痛いんですか? ...
-
変な話しになります。尿検査で...
-
これって喉仏ですか? 私は女性...
-
EXCELで条件付き書式で空白セル...
-
男です。昨日の午後3時くらいに...
-
今朝、毎朝の習慣でオナニーし...
-
納豆食べた後の尿の納豆臭は何故?
-
1日前の検尿
-
値が入っているときだけ計算結...
-
精子が黄色?
おすすめ情報