• 締切済み

VBAで条件式について

EXEL(VBA)で例えば、A列のデータが入っている行までの中で数値(x)が  x<2 ならばセルに色をぬる。そして空白セルと x>2ならば色をぬらない。 という条件式は、どうしたらいいのですか? Sub InteriorColor() For j= 5 to 21 worksheets(j).activate For i = 1 to 40 '30から40行ぐらい While cells(6+i,6)<>"" If(cells(6+i,6).value<2) Then ’6列7行目から  with selection.interior .Colorindex=45 .patern=xlsorid End with Wend End if Next i Next j End sub ということを連続していない列(5列ぐらい)に対してします。 同じ命令文になる部分もあるので簡潔にしたいという希望もあります。 上部の命令では無限ループの可能性があり実行が止まりません。 どのように記述したらいいのですか? また、同じブックのシート25枚のうち5枚目から21枚目に対して処理します。 5から21までのシートの間で関係ないシートが7枚目と10枚目と15枚目にあります。それを省いての処理もあれば教えてください。

みんなの回答

  • nishi6
  • ベストアンサー率67% (869/1280)
回答No.1

質問の意味を理解している? 質問のコードを少し変えて見ました。 『30から40くらい、連続していない列(5列くらい)』の捉え方が問題ですが、そこにデータが入っていると解釈して書いています。6列目より右、7行目より下を対象にしています。 ご参考に。 Sub InteriorColor2()   Dim ws As Worksheet 'ワークシート   Dim wsIdx As Integer 'ワークシートのインデックス   Dim rw As Long '行カウンタ   Dim col As Integer '列カウンタ   Dim rwLast As Long '使っている最後の行   Dim colLast As Integer '使っている最後の列   Dim actvSheet As Integer '最初のシート   actvSheet = ActiveSheet.Index 'マクロを起動したシート   Application.ScreenUpdating = False '画面更新を止める   For wsIdx = 5 To 21     '必要なシートだったら色を塗る処理を行う     If Not (wsIdx = 7 Or wsIdx = 10 Or wsIdx = 15) Then       Set ws = Worksheets(wsIdx) 'ワークシートを定義       '色を塗るシートをアクティブにする       ws.Activate         '使っている最後の行         rwLast = ws.Cells.SpecialCells(xlCellTypeLastCell).Row         '使っている最後の列         colLast = ws.Cells.SpecialCells(xlCellTypeLastCell).Column         For rw = 7 To rwLast '7行目から使っている最後の行まで           For col = 6 To colLast '6列目から使っている最後の列まで             'セルの内容が数字だったら             If IsNumeric(Cells(rw, col)) = True Then               '入力があって2未満だったら               If Cells(rw, col) <> "" And Cells(rw, col) < 2 Then                 Cells(rw, col).Interior.ColorIndex = 45                 Cells(rw, col).Interior.Pattern = xlSolid               End If             End If           Next         Next     End If   Next   Worksheets(actvSheet).Select 'マクロを起動したシートに戻す   Application.ScreenUpdating = True '画面更新を戻す End Sub

a12b06
質問者

お礼

参考になりました。ありがとうございました。

関連するQ&A

  • VBA教えて下さい

    VBA初心者です やりたいこと 変数を宣言し 今開いているシート(activesheet)に for nextを使用し 列5~20を調べ 行3~5を指定し もし、5~20列の2行目のどれかに”No.8”という文字があれば(ここまでのコードは書けました) その当てはまる列の3~5行を選択し(1) 更に、(1)の下2列を選択する(2) そして、(1)と(2)を結合させる といったコードが書きたいです 考えたコード Sub test() Dim i As Long Dim j As Long With ActiveSheet For j = 5 To 20 For i = 3 To 5 If .Cells(j, 2) Like "*No.8*" Then 'ここからがわかりません End If Next i Next j End With End Sub 変な書き方なので例えを書きます A1セルにNo.8の文字があれば E1セルとF1セルを選択し 更に、E3セルとF3セルも選択し E1セルとF3まとめてセルを結合といったことがしたいです。 質問頂ければ追記しますm(ーー)m おそらくoffsetを使用して選択すると思うのですが上手く出来ませんでした 回答お願い致します

  • VBA教えて下さい

    for nextの使い方がわかりません 変数を使用し条件に当てはまる数値だけ 処理するといった内容です 考えたコード sub test() dim a as variant dim b as variant dim i as variant with workbooks("book1").activesheet set a =.range("A5") set b =.range("B5") end with with workbooks("book2").activesheet for i = 80 to 110 if a = cells(i,1) then b.value = cells(i,2) end if next i end sub このコードにてやりたい事は まず、book1の今開いてるシートを参照し A5セル、B5セルをセットし (例えばA5は2と入力している B5セルは10000と入力している) 次に、book2の今開いてるシートを参照し もし、1行目の80~110どれかのセルの数字が 変数aと同じ値ならば (A行80~110行のセルの数字2があれば 例えば85列) 変数bの数字を2行目の80~110に条件に当てはまるセルに移す (B行85列にB5セルの値10000を移す) ()の部分は例えで書いてます 読みにくかったら無視でお願いしますm(__)m 指定の仕方など間違ってると思うので コードを書いてくれると助かります 回答お願いしますm(__)m

  • VBAのプログラムでうまく動かなくて困っています。

    VBA初心者です。 エクセルのVBAのプログラムでうまく動かなくて困っています。教えていただける方がいらしたら、ぜひ教えて下さい!よろしくお願いします。エクセルの内容は以下のとおりです。 (内容) セル    E H J L N P R・・・ 8行目100 200 50 40 30 80 9行目130 350 10 50 60 120 110 ・ ・ (1)列Hの値が列Eの値より大きい場合その下に行を追加します。 (2)セルJ+セルL+セルN+・・をしてセルEの値を超えたセル以降の値を追加した行のセルJ列から順にコピペする処理です。 上のセルの1行目の内容でいいますと、 (1)列Hの値「200」が列Eの値「100」より大きいのでその下に行追加 (2)セルJ、L、N「50」+「40」+「30」でセルEの値「100」より大きいので、追加した行のセルJ列にセルN、Pの値をコピペするです。 以下が私が書いたプログラムです。 Sub test() Dim x As Integer Dim s As Integer Dim t As Integer x = Range("B8").End(xlDown).Row r = Range("J8").End(xlToRight).Column '8行目から最終行までループ For i = x To 9 Step -1 If Cells(i, 5) < Cells(i, 8) Then ☆【For r = y To 11 Step -2 Cells(s, t).Value = Cells(i, r) + Cells(i, r + 2) If Cells(i, 5).Value < Cells(s, t).Value            Then Exit For Next】 Rows(i + 1).Insert Shift:=xlDown '超えたセルをコピーして、1行下の"J列以降"に代入 ★ x = x + 1 End If Next i End Sub 上記プログラムで★の部分がうまく書けません。☆の部分も間違っているような気がします。よろしくお願いします。

  • マクロで全てのシートで条件を満たすシートに行を挿入するにはどうしたらいいですか

    マクロ初心者です。自分でも作ってみたのですが、なかなか思うようにいかず困っています。 book内のシート3つ目から最後のシートで、条件に一致するシートの特定位置に行を挿入するということがしたいのですが。 条件とは、1列目の最後の行に「合計」と記入されていれば、行を4行挿入し、上の書式をコピーするというものです。 下記に記しているマクロは、シートを指定した場合には動くのですが、これにシートをnとして、FOR...Nextを付け加えてシートを順番に参照させようとしても、うまくいきません。 Sub 行挿入sample3() With Sheets("10007") For i = 7 To .Cells(Rows.Count, 1).End(xlUp).Row If .Cells(i + 1, 1) = "" Then Exit For ElseIf .Cells(i + 1, 1) = "合計" Then Range(Cells(i + 1, 1), Cells(i + 4, 1)).Select Selection.EntireRow.Insert Range(Cells(i, 1), Cells(i, 3)).Select Selection.Copy Range(Cells(i + 1, 1), Cells(i + 4, 3)).PasteSpecial xlPasteFormats End If Next i End With End Sub 知識をお持ちの方、教えていただけるととても助かります。よろしくお願いします。

  • Excel VBA 条件を満たすデータのコピーと計算結果の表示

    Excel2003を使用しています。 Sheet1のある選択範囲に対して(都度、手動で選択します) D列-E列が0でなかったら、その行のデータをSheet2のアクティブセル以下にコピーするという処理を下記のマクロでしています。 下記のマクロにコードを追加することによって、条件を満たすデータをコピーする際、D列-E列の計算結果をSheet2のD列に表示させることは可能でしょうか? 例えば、Sheet1のD5セルに100、E5セルに50と数値が入力されていた場合、Sheet2のD7セルに50と計算結果を表示させたいですのですが…。 (貼り付け先の行は、アクティブセルの行です) よろしくお願いします。 -------------------------------------------------- Sub Macro1()  Sheets("Sheet1").Activate '選択範囲のサイズ取得   With Selection    i = .Cells(1).Row    j = .Cells(1).Column    k = .Cells(.Count).Row    l = .Cells(.Count).Column   End With  Sheets("Sheet2").Activate   ActR = ActiveCell.Row   ActC = ActiveCell.Column  With Sheets("Sheet1")   For m = i To k    If .Cells(m, 4) - .Cells(m, 5) <> 0 Then     .Range(.Cells(m, j), .Cells(m, l)).Copy     Sheets("Sheet2").Cells(ActR, ActC).PasteSpecial Paste:=xlPasteAllExceptBorders     ActR = ActR + 1     Application.CutCopyMode = False    End If   Next  End With End Sub

  • VBAの操作

    ↓の事を行いていのでうまくいきません。 アドバイスをお願いできませんか? 変更前(Sheet1); (A列) (B列) 1 ABC010 Data_010 2 ABC020 (同上) 'B1-B2は結合セル 3 ABC030 Data_020 4 ABC040 (同上) 'B3-B4は結合セル . . 変更後(Sheet2); (A列) (B列) 1 ABC010 "OK" 2 ABC020 "OK" 3 Data_010 "Comp" '追加行 4 ABC030 "OK" 5 ABC040 "OK" 6 Data_020 "Comp" '追加行 . . Sheet1(B列)に値があれば、 Sheet2(A列)に結合セルの単位で値をコピーする。 Sheet2(B列)には"OK"コメント その都度、必ず最後に行追加して結合セルの値、"Comp"コメントをコピーする. 現象は毎行、追加行が挿入されてしまいます。 Sub testVBA() Dim i Worksheets("Sheet1").Range("A:B").Copy With Worksheets("Sheet2") .Range("A1").PasteSpecial For i = 1 To 1000 If .Cells(i, 2) <> "" Then .Cells(i + 1, 1) = .Cells(i, 2) .Cells(i + 1, 2) = "Comp"   .Cells(i, 2) = "OK" End If Next i End With End Sub

  • マクロ:データの抽出(複数条件)

    エクセルで以下のようなマクロを作成しました。 シート1のG列がシート2のF4と合致する時、シート2のC列にシート1のB列を貼り付けるのですが、条件を増やし 「シート1G列がシート2のF4と一致」かつ「シート1H列がシート2のG5と一致」かつ「シート1I列がシート2のH5と一致」かつ・・・としたいのですが、If Thenをどのように記述したらよろしいでしょうか。(AND関数の機能です) 宜しくお願いいたします。 Sub data01() With Sheets("Sheet1") x = .UsedRange.Cells(.UsedRange.Count).Row For i = 5 To x If .Cells(i, "G").Value = Worksheets("Sheet2").Range("F4").Value Then n = n + 1 Sheets("Sheet2").Cells(n + 5, "C").Value = .Cells(i, "B").Value End If Next End With End Sub

  • VBA どこでもセル選択

    教えて頂いたVBAなのですがもう一つ Sub Macro1() Dim Ws01 As Worksheet Dim Counter As Long, i As Long, j As Long Dim INP As String Set wS = Worksheets("Sheet4") wS.Cells.ClearContents For i = 3 To ActiveSheet.UsedRange.Rows.Count INP = "" For j = Selection(1).Column To Selection(Selection.Count).Column If Cells(i, j) = 1 Then INP = INP & Cells(2, j) & "," End If Next j Counter = Counter + 1 If INP <> "" Then wS.Cells(Counter, "A") = Left(INP, Len(INP) - 1) End If Next i End Sub -------------------------------------------------------------- For i = 3 のところを3としないでどのセル(行)にも対応させたいのですが どうすればいいでしょうか?

  • EXCEL VBAのFor...Nextについて

    VBA初心者です。よく理解していませんので、質問も的を得ていないかもしれませんが、ご指導宜しくお願いいたします。  現在、For...Nextを使った表計算をしています。 A列に「す」という文字が含まれていたら、B列の「す」の行に「あ」と「い」と「え」「か」のセルの合計をだす。C列、D列・・・最終列まで計算する。 上記VBAを作成する方法を教えて下さい。 A  B  C  D  E   F  G  H  I  J  K  L 1 2    3    4   5    6    7    8    9    10    11 12 あ  1 2 3 4   5 6 7 8 9 10 11 い 10 20 30 40  50 60 70 80 90 100 110 う 20 30 40 50   60 70 80 90 100 110 120 え 40 50   60  70 80 90  10 20 120 130 30 お 50 60   70  80 90 10  20 30 130 140 40 か 60 70   80  90 10 20  30 40 140 150 50 す 私は表に1~12まで数字をインプットし下記のようなコードを考えました。 Sub 列合計() Dim i, k, l, m, n As Long j = 2 For i = 6 To 120 For k = 6 To 120 For l = 6 To 120 For m = 6 To 120 For n = 6 To 120 If Cells(i, 1) = "す" And Cells(k, 1) = "あ" And Cells(l, 1) = "い" And Cells(m, 1) = "え" And Cells(n, 1) = "か" Then Do While j <= Range("A2").End(xlToRight) Cells(i, j) = Cells(k, j) + Cells(l, j) + Cells(m, j) + Cells(n, j) j = j + 1 Loop Else: End If Next n Next m Next l Next k Next i End Sub この内容だとエラーが出てしまいます。 補足ですが、あいうえおかの順番はかわったり、間に他の行が入ったりします。 また今回はL列の間としましたが、もっと列が増え、最終列まで計算する方法を知りたいのですが、どうぞ宜しくお願い致します。 ※ofice2013です。

  • VBAで複数行の指定

    VBA教えてください  初心者です やりたい事 for next文を使用しbook1のシート内N~R行にある文字が入っていたなら book2のシート内のB行の文字を消すといった内容です 考えたコード sub test() dim c as variant dim i as long Set c = Workbooks("book2.xls").ActiveSheet With Workbooks("book1.xls").ActiveSheet For i = 1 To 100 If .Cells(i, 14) Like "*受入*" Then 'もし、14行目のセルのどれかに『受入』という文字が入っていたら c.Cells(i, 2).Clear 'その2行の条件に当てはまるセルをクリアする End If Next i End With end sub これではbook1のシートに内のN行しか反映されません 複数行N~Rに反映させるコードわからないです 教えてもらえるとすごく助かります。

専門家に質問してみよう