- ベストアンサー
【マクロ】全シートでまとめて実行するには？
chibita_papaの回答
- chibita_papa
- ベストアンサー率60% (127/209)
＞『型が違います』とエラーが出てしまいます。 おそらく、Ａ列に #N/A が有りませんか。 別解ですが VBEエディターのThisWorkbookのシートに Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range) Dim R As Long If Target.Column >= 3 Then Exit Sub For R = 1 To Cells(Rows.Count, "B").End(xlUp).Row If Cells(R, "B").Value = "土" Or Cells(R, "B").Value = "日" Then Cells(R, "A").Resize(1, 5).Interior.ColorIndex = 6 else Cells(R, "A").Resize(1, 5).Interior.ColorIndex = xlNone End If Next R End Sub とすれば、データを入力する都度色が変わります。 またまた、別解ですが これは、ＶＢＡで作るより条件付き書式で対応すべきだと 思いますが 条件付き書式をご存じなかったら調べるか、再度質問してください。
関連するQ&A
- マクロで教えてください。
sheet1のA列にある図番を参照しsheet2のA列の機種名に適合する行全体に sheet1のB列にある色を塗りたいのですが、マクロを教えていただけますでしょうか？ sheet2のBのセル色を塗るマクロはわかりました。↓です。 Sub macro1() Dim c As Range, myR As Variant With Sheets("Sheet2") For Each c In .Range("a2", .Cells(Rows.Count, "a").End(xlUp)) myR = Application.Match(c.Value, Sheets("sheet1").Columns(1), 0) If Not IsError(myR) Then c.Offset(, 1).Interior.ColorIndex = Sheets("sheet1").Cells(myR, "B").Interior.ColorIndex End If Next End With End Sub 上記マクロですとBセルのみ色が塗られてしまうので行全体を塗るマクロを教えてください。 よろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- エクセル マクロ 複数セルの色付けについて
マクロ初心者で苦戦しており、教えていただけると大変ありがたいです。 エクセルの複数のシートに、問2_1 、問2_2 、問2_10 （全部で問は2_28まであります）等の文字列があり、その文字に合わせて、そのセルだけ色を付けたいと考えております。 今書いているコードだと、ワークシートのA列にある場合は色が付けられるのですが、それ以外に色が付けられません。どこが間違っているでしょうか？ どうぞご指導お願いいたします。 Sub 色つけ() Dim Maxrow As Long Dim i As Long Maxrow = Cells(Rows.Count, i).End(xlUp).Row For i = 1 To Maxrow If InStr(Cells(i, 1), "2_1 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 6 If InStr(Cells(i, 1), "2_2 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 6 If InStr(Cells(i, 1), "2_23 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 23 If InStr(Cells(i, 1), "2_13 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 4 If InStr(Cells(i, 1), "2_6 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 7 Next i End Sub
- 締切済み
- Visual Basic
- 2枚のエクセルのシートを図のように統合させる
2枚のエクセルのシートを統合させるやり方を教えて下さい。 (同じ項目に２人の人が答えている場合2行に分けることはできますか。) 以前こちらで質問させていただいたとき、 Sub test() Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim Sh3 As Worksheet Set Sh1 = Workbooks("book1.xls").Sheets("Sheet1") Set Sh2 = Workbooks("book2.xls").Sheets("Sheet1") Set Sh3 = Workbooks("book3.xls").Sheets("Sheet1") Sh1.Range("B5").CurrentRegion.Copy Sh3.Range("B5") With Sh2.Range("B5").CurrentRegion .Resize(.Rows.Count - 1).Offset(1).Copy Sh3.Cells(Sh3.Rows.Count, "B").End(xlUp).Offset(1) End With With Sh3 Dim r As Long For r = .Cells(.Rows.Count, "B").End(xlUp).Row To 6 Step -1 If .Cells(r, "C").Value = "" Then .Rows(r).Delete Next r .Range("B5").CurrentRegion.Sort Key1:=.Range("B6"), Order1:=xlAscending, Header:=xlYes For r = .Cells(.Rows.Count, "B").End(xlUp).Row To 6 Step -1 If .Cells(r, "B").Value = .Cells(r - 1, "B").Value Then .Cells(r, "B").ClearContents Next r End With End Sub というコードを教えていただいたのですが、項目の中があいうえお順になってしまいうまくいきません。 そして、途中に項目があったりしてこれは１つだけ表示されるようにできますか？ 説明が足りないところは、補足いたします。 いきなり部署を異動させられて今までやったことないようなことをやっています(涙) どなたか教えて下さいよろしくお願いします。
- 締切済み
- オフィス系ソフト
- マクロ 検索範囲を修正したい 1つ置きのセルで
前に以下のマクロをここで教えていただきました。このときはB列からF列の範囲でお願いしたのですが、F列～AG列の1つ置きのセル（G、I、K・・・列）で検索したいです。どう修正したらよいですか？初心者なので調べても分からなかったので教えてください。 Sub Sample1() 'この行から Dim i As Long, j As Long, vL vL = InputBox("検索値を入力してください。") Application.ScreenUpdating = False Cells.Interior.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row For j = 2 To 5 With Cells(i, j) If .Value <> "" And .Value >= vL - 3 And .Value <= vL + 3 Then .Interior.ColorIndex = 36 End If End With Next j Next i Application.ScreenUpdating = True End Sub 'この行まで
- ベストアンサー
- オフィス系ソフト
- マクロを使って・・・
シート1に入力したデータをシート2にコピーするいうマクロを作りました。 シート2にコピーはできるのですが 例えば、そのデータを消して再度新しいデータを入れていきたいと思い エクセル左上のシート全体を選択して「Delete」を押すと 会社のエクセル（2003？）は中断モードがどーのこーのとエラー画面が出て マクロが黄色になって、前に進めません。 やり方が決まっているのでしょうか? コピーした行全体を選択して右クリック「削除」とすると エラー画面が出ません。 やり方など決まっているのでしょうか? ↓がんばって作ったマクロです Sub 正方形長方形4_Click() Call macro01 Call macro02 End Sub Sub macro01() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Long, y As Long Set ws1 = Sheets("Sheet1") Set ws2 = Sheets("Sheet2") x = ws2.Cells(Rows.Count, "b").End(xlUp).Row + 1 y = ws1.Cells(Rows.Count, "b").End(xlUp).Row ws1.Cells(21, "b").Resize(y, 9).Copy ws2.Cells(x, "B").PasteSpecial Paste:=xlPasteValues ←この行が黄色になります Application.CutCopyMode = False End Sub Sub macro02() Worksheets("Sheet1").PrintOut End Sub
- ベストアンサー
- オフィス系ソフト
- 条件付き書式での色付けで以下のコードを教えて頂いたんですが、色付けを
条件付き書式での色付けで以下のコードを教えて頂いたんですが、色付けを 適用する範囲をどうやって変更すればいいのでしょうか？ もしよろしければ、範囲の変更の仕方と、コードの意味を教えて頂けますか？ めんどうですがよろしくお願いします・・・。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Columns(3).Interior.ColorIndex = xlNone Dim i, j As Long For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row For j = 1 To Cells(Rows.Count, 6).End(xlUp).Row If Cells(i, 3) = Cells(j, 6) Then Cells(i, 3).Interior.ColorIndex = Cells(j, 7).Interior.ColorIndex End If Next j Next i End Sub
- ベストアンサー
- オフィス系ソフト
- 【Excel VBA】データ貼り付けの開始位置について
Excel2003を使用しています。 先日、こちらでアドバイスをいただきながら、下記のようなマクロを作りました。内容はあるセルの値と同じ名前のシートへデータをコピーするというものです。 Sheet1に貼り付け元のデータが表形式であり、必要なデータのみ該当のシートへコピーします。マクロ実行後は、別の新しいデータをSheet1へコピペして、またマクロを実行するのですが、その際、データの貼り付け開始位置を前回マクロを実行して貼り付けられたデータから2行空けたいのですが、可能でしょうか？ ________________________________________________________________________________________________________________________________ Sub test3() Dim n As Long Dim i As Long Dim j As Long Worksheets("Sheet1").Activate For n = 4 To Cells(Rows.Count, 2).End(xlUp).Row If Cells(n, 3).Value <> "" Then With Worksheets(CStr(Cells(n, 3).Value)) i = .Cells(Rows.Count, 3).End(xlUp).Row + 1 Cells(n, 2).Copy .Cells(i, 2) Cells(n, 7).Resize(, 2).Copy .Cells(i, 4) Cells(n, 11).Copy .Cells(i, 3) End With End If If Cells(n, 13).Value <> "" Then With Worksheets(CStr(Cells(n, 13).Value)) j = .Cells(Rows.Count, 3).End(xlUp).Row + 1 Cells(n, 12).Copy .Cells(j, 2) Cells(n, 17).Copy .Cells(j, 4) Cells(n, 18).Copy .Cells(j, 6) Cells(n, 11).Copy .Cells(j, 3) End With End If Next n End Sub
- ベストアンサー
- オフィス系ソフト
- Excelでwatabeさんに複数のセルを参照
Excel2007でwatabe007さんに以前に作って頂いたこのようなソースがあります。 Sub Test4() Dim LastO As Long, LastG As Long Dim i As Long, str As String Range("D3", Cells(Rows.Count, "F").End(xlUp)).ClearContents LastO = Cells(Rows.Count, "O").End(xlUp).Row Range("A3:C3").Value = Cells(LastO, "O").Resize(, 3).Value str = Range("A3").Value & Range("B3").Value & Range("C3").Value For i = 3 To LastO If str = Cells(i, "O").Value & Cells(i, "P").Value & Cells(i, "Q").Value Then LastG = Cells(Rows.Count, "D").End(xlUp).Row + 1 If LastG < 3 Then LastG = 3 Cells(LastG, "D").Resize(, 3).Value = Cells(i + 1, "O").Resize(, 3).Value End If Next End Sub これにいつも格子をつけて文字がセンターになるようにしたいですがどうすればよろしいですか？解答よろしくお願いいたします。
- ベストアンサー
- Excel（エクセル）
- エクセルVBAで複数シートにマクロ実行
エクセル2000です。 Sub 行列非表示() For i = 2 To 120 If Cells(i, "A").Interior.ColorIndex = 3 Then Cells(i, "A").EntireRow.Hidden = True End If Next i For n = 1 To 50 If Cells(1, n).Interior.ColorIndex = 3 Then Cells(1, n).EntireColumn.Hidden = True End If Next n End Sub 上記マクロを、シートAAAとCCCとEEEに実行する場合、 Sub test() Sheets("AAA").Activate Call 行列非表示 Sheets("CCC").Activate Call 行列非表示 Sheets("EEE").Activate Call 行列非表示 End Sub と書くよりももっとすっきり実行する方法は無いでしょうか？ 各シートの非表示対象の行や列はそれぞれことなります。 また Sub 行列非表示 自体も、もっと効率的にやる方法はないでしょうか？
- ベストアンサー
- オフィス系ソフト
- 実行時エラー1004空白セルを上に詰める
よろしくお願いします いろいろ試しましたが解決できませんでした。 Private Sub CommandButton1_Click() With Worksheets("Sheet1") For r = 2 To .Cells(Rows.Count, "C").End(xlUp).Row If .Cells(r, "C").Value = 提出先.Value Then Me.提出先.Value = "" .Cells(r, "C").Value = "" Else End If Next r .Range("J3").Value = "" ’下記の構文でエラーが出ます ’実行時エラー1004 ’アプリケーション定義またはオブジェクト定義のエラーです .Range(Range("C2"), Cells.SpecialCells(xlCellTypeLastCell)).SpecialCells (xlCellTypeBlanks).Delete Shift:=xlUp End With End Sub
- ベストアンサー
- Visual Basic
補足
chibita_papaさん、ありがとうございます。 条件付き書式はすでに３つとも使っている状態だったので マクロにしました。 色々な方法があるのだと、勉強になり たすかりました。本当にありがとうございました。