• 締切済み

Private Subについて教えてください

fumufumu_2006の回答

回答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 ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- というのは、どういう意味でしょうか? もしかしたら動かないプログラムを載せてもらった方がわかるかもしれません。

iokmuoyt
質問者

補足

ありがとうございます。 #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の色が変更 これが最終的にやりたかったことですが、全く分からなかったので 一つずつ解決していこうと思っていましたが。。。

関連するQ&A

  • Private sub の使い方

    Private Sub Worksheet_Activate() Dim ANS As Integer ANS = MsgBox("Bをクリアしてもいいですか?", _ vbYesNo + vbInformation, "クリア実行") If Sheets("B").Range("D6").Value <> "" Then Select Case ANS Case vbYes Sheets("営業確認").Range("D6:E1000").Select Selection.ClearContents Sheets("入力").Select MsgBox "クリアしました" Case vbNo MsgBox "キャンセル" End Select Else End If End Sub 質問 『A』のシートを開いた時に『B』のシートのD6に値があれば、MsgBoxを出すようにしたく上記のマクロを組みましたが、値が無くてもMsgBoxが表示されてしまいます。 どこがおかしいのかアドバイスをお願いします。

  • 【VBA】初心者です セルの貼り付けについて

    VBAについてご質問です 以下のようなVBAを、こちらの質問等を参考に作成したのですが、 シートにそれぞれデータを貼り付ける際、値貼り付けになってしまいます 書式ごと貼り付けるようにしたのですが、どのように改良すればよいでしょか ご教示よろしくお願いいたします Sub ぶんるい() Dim r As Long Dim Target As Variant For r = 14 To 100 Select Case Cells(r, "D").Value Case "大阪" Target = "大阪" Case "名古屋" Target = "名古屋" Case Else Target = "" End Select If Target <> "" Then Worksheets(Target).Range("A65536").End(xlUp).Offset(1).Resize(1, 14).Value = _ Cells(r, "H").Resize(1, 14).Value End If Next r End Sub

  • マクロで二つの構文を繋ぐには

    いつもお世話になります。 WIN7 EXCELL2010 です。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$A$1" Then Sh.Name = Target.Range("A1").Value End Sub ThisWorkbook に上記のマクロに下記のマクロを追加したいのですが、 End Sub の ところを End If End With などに変えたのですがうまくゆきません。 御指導お願いできませんでしょうか。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim myRange As Range Set myRange = Intersect(Target, Range("M3:V27")) If Not myRange Is Nothing Then Select Case Target.Value Case "" Target.Value = "○" Case "○" Target.Value = "●" Case Else Target.ClearContents End Select Cancel = True End If End Sub 宜しくお願いいします。

  • エクセル VBA シートの選択 

    windows XP でエクセル2000を使っています。 Sub aaa() Sheets("Sheet1").Select Dim a As String a = Cells(2, 4) Sheets(a).Select Range("A1").Select End Sub というマクロだと セルに入っている値のシート名を探してくれます。 ですが Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Intersect(Target, Range("B11:b683")) Is Nothing Then Exit Sub Worksheets("Sheet1").Range("C2").Value = Target.Value Dim b As String b = Range("C2).value (←ここをcellsにしてもダメ) Sheets(b).Select Range("A1").Select End Sub これだとsheets(b)を選びません。Sheets(b).Selectのところが黄色くなります。 何処が間違えているのでしょうか。 全くの素人ですが、仕事で必要に迫られています。 わかりやすく回答・解説くれると助かります。

  • エクセルのマクロ

    セルの値が変わったら動くマクロですが、2つ書くとエラーが出ます。 どのように直したらいいでしょうか? Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address If Intersect(Target, Range("EK22")) Is Nothing Then Exit Sub Else Range("EK24:EM28").Select Selection.ClearContents End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("EK24")) Is Nothing Then Exit Sub Else Range("EK27:EM28").Select Selection.ClearContents End If End Sub

  • 同じシート内にイベントプロシージャが二つある時

    いつもお世話になります。 WINDWS7 EXCELL2010 です。 下記の1 2のマクロを同じシート内にイベントプロシージャを二つ挿入したところ、 ※1 ※2のような現象が起きました。 この現象を解決したくご指導を仰ぎたいです。 宜しくお願いします。 ※1 エラー表示 コンパイルエラー: 名前が適切ではありません; Worksheet_BeforeDoubleClick ※2 下記の構文が青色に反転 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 1 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("A2:A51")) Is Nothing Then Exit Sub Cancel = True Sheets(CStr(Target.Value)).Select End Sub 2 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim myRange As Range Set myRange = Intersect(Target, Range("B2:B51")) If Not myRange Is Nothing Then Select Case Target.Value Case "" Target.Value = "○" Case Else Target.ClearContents End Select Cancel = True End If End Sub

  • ThisWorkBookモジュールとSheetモジュールの両立

    エクセル2003でマクロを組んでいます。 Sheet1,Sheet2の2つのシートがあり、 片方のシートの"A4:G10"の範囲に値を書き込むと、もう片方の同じ位置に同じ値が書き込まれるようなマクロを組みたいです。 以前ここで教えていただいたものを改変して以下を作りました(ThisWorkBookモジュールです)。 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim r As Range Dim Num As Integer Dim S As String, Sh_name As String Sh_name = ActiveSheet.Name Set r = Intersect(Target, Range("A4:G10")) If Not (r Is Nothing) Then Application.EnableEvents = False For Num = 1 To 2 S = "Sheet" & Num If S <> Sh_name Then Worksheets(S).Range(r.Address).Value = r.Value End If Next Application.EnableEvents = True End If End Sub ここまでは正常に動作します。 また、 Sheet1とSheet2のモジュールに、 A列のセルに値が入力された場合、同じ行のC列のセルの色を塗るという記述をしています。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then Cells(Target.Row, 3).Interior.ColorIndex = 5 End If End Sub これらを同時に生かしたいのですが、 どのように書けばいいでしょうか。 EnableEvents = False/Trueを消してしまうと、 Worksheets(S).Range(r.Address).Value = r.Valueが実行されるたびにThisWorkBookモジュールが動いているようです。 そして2回目のSet r = Intersect(Target, Range("A4:G10"))でエラーが出ます。 (エラーは出ずとも延々と(無限ではない回数)ThisWorkBookモジュールを繰り返したコードもありました。) よろしくお願いします。

  • EXCEL マクロ 条件によるセルの色付け

    お世話になります。 マクロは初心者です。 C列の数値1~6によって、E列に色付けしたく、ネットで色々検索して、 下記のように組んだのですがコマンドボタンクリックでは上手く動かない のですが、どのように修正すればよいのでしょうか。教えて下さい。 宜しくお願いします。 Private Sub CommandButton4_Click() Dim i As Range Dim r As Range Dim c As Range Dim myColor As Long Set i = Worksheets("マスタ").Range("C:C") Set r = Worksheets("マスタ").Range("E:E") If Intersect(Target, i) Is Nothing Then Exit Sub For Each c In Intersect(Target, i) With c Select Case .Value Case "1" myColor = 22 Case "2" myColor = 44 Case "3" myColor = 6 Case "4" myColor = 43 Case "5" myColor = 41 Case "6" myColor = 24 Case Else myColor = xlColorIndexNone End Select Intersect(c.EntireRow, r).Interior.ColorIndex = myColor End With Next End Sub

  • マクロ作動

    Private Sub Worksheet_SelectionChange(ByVal Target As Range) tm = Time() '現在時間を取得 If tm < TimeValue("08:30:00") Then Exit Sub If tm > TimeValue("09:30:00") Then Exit Sub  Dim ANS As Integer  Dim 値 As String If Sheets("営業確認").Range("D6").Value <> "" Then ANS = MsgBox(Sheets("営業確認").Range("B6") & "のデーターが残っています。クリアしますか?", _ vbYesNo) Select Case ANS Case vbYes Sheets("営業確認").Select Sheets("営業確認").Range("B6:E461").Select Selection.ClearContents Sheets("営業確認").Range("G6:K461").Select Selection.ClearContents Sheets("入力").Select MsgBox "クリアしました" Case vbNo MsgBox "キャンセル" End Select Else End If End Sub プログラムを組みましたが、上記のとおり時間設定している間は『キャンセル』をしてもセルを動かす度にマクロが動いてしまいます。 下記のようなマクロは可能でしょうか。 (1)一番最初にシートが開くとマクロが作動 (2)その後、指定してるシートに値があってもマクロは作動しない (3)また翌日シートを開くとマクロが作動 ※1日1回マクロが作動出来ればいいです

  • Private Sub Worksheet_BeforeDoubleC

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 4 Then Target.Value = Date End If If Target.Column = 5 Then Target.Value = Date End If End Sub これは、他の方の回答で4列と5列のどこかをダブルクリックすると日付が入力されました。 しかし、シートの保護を入れるとダブルクリックしても入力されません。 それで、例えば、B3セルとかC3セルとかの特定のセルをダブルクリックすると日付が入力されるようにできませんか?宜しくお願いします。