• 締切済み

ただいまEXCEL VBA(アドイン)の勉強中です。

ただいまEXCEL VBA(アドイン)の勉強中です。 会社の人が作ったものをコピーしたりして応用しています。項目追加とかしかできませんが。。。 そこで課題を出されたのですが、わからなくて書き込みしました。 簡単に言うと、複数ある条件に当てはまるものがあったらセルを塗りつぶし、フォントの色を変えることです。 今は、条件が Range(Out_都市名IC & Out_Cnt).NumberFormatLocal = "@" Range(Out_都市名IC & Out_Cnt).HorizontalAlignment = xlRight Range(Out_都市名IC & Out_Cnt).Value = Range(Inp_都市名IC & Inp_Cnt).Value If Range(Out_都市名IC & Out_Cnt).Value = "松山市" Then Range(Out_都市名IC & Out_Cnt).Font.Bold = True Range(Out_都市名IC & Out_Cnt).Font.ColorIndex = 41 Range(Out_都市名IC & Out_Cnt).Interior.ColorIndex = 34 Range(Out_都市名IC & Out_Cnt).Interior.Pattern = xlSolid ElseIf Range(Out_都市名IC & Out_Cnt).Value = "広島市" Then Range(Out_都市名IC & Out_Cnt).Font.Bold = True Range(Out_都市名IC & Out_Cnt).Font.ColorIndex = 41 Range(Out_都市名IC & Out_Cnt).Interior.ColorIndex = 34 Range(Out_都市名IC & Out_Cnt).Interior.Pattern = xlSolid ElseIf Range(Out_都市名IC & Out_Cnt).Value = "仙台市" Then Range(Out_都市名IC & Out_Cnt).Font.Bold = True Range(Out_都市名IC & Out_Cnt).Font.ColorIndex = 41 Range(Out_都市名IC & Out_Cnt).Interior.ColorIndex = 34 Range(Out_都市名IC & Out_Cnt).Interior.Pattern = xlSolid ElseIf Range(Out_都市名IC & Out_Cnt).Value = "函館市" Then Range(Out_都市名IC & Out_Cnt).Font.Bold = True Range(Out_都市名IC & Out_Cnt).Font.ColorIndex = 41 Range(Out_都市名IC & Out_Cnt).Interior.ColorIndex = 34 Range(Out_都市名IC & Out_Cnt).Interior.Pattern = xlSolid End If とこんな感じにしてできていたのですが、条件が30個以上ある中から対応させようとすると、 これでは大変なので、簡単にできないかなと思いまして。。。 会社の人からも条件だけを登録(他のシート?)できてそこから抜き出せるプログラムにできないか?といわれています。 どうでしょうか?

みんなの回答

  • layy
  • ベストアンサー率23% (292/1222)
回答No.4

処理を2つに分けて考えます。 >Range(Out_都市名IC & Out_Cnt).Value = "松山市" 30個にヒットしたかどうかの判定をして、結果を特定のセルへセットする。 「OK」「NG」とか。 特定のセル=「OK」なら Range(Out_都市名IC & Out_Cnt).Font.Bold = True Range(Out_都市名IC & Out_Cnt).Font.ColorIndex = 41 Range(Out_都市名IC & Out_Cnt).Interior.ColorIndex = 34 Range(Out_都市名IC & Out_Cnt).Interior.Pattern = xlSolid の処理をさせる。 これなら上の処理部分のみ(対象都市増減時に)考えれば良い。 これをシート上にどうもたせるかです。

  • hallo-2007
  • ベストアンサー率41% (888/2115)
回答No.3

>会社の人からも条件だけを登録(他のシート?)できてそこから抜き出せるプログラム グッドアドバイスだと思います。 仮に シート名 登録として 検索文字   文字色 セル色 松山市     34   41 広島市     34   41 ・・・と一覧表を準備します。 Dim c As Range With Worksheets("登録").columns(s1) '---1列目が対象 Set c = .Find(What:=Range(Out_都市名IC & Out_Cnt).Value, LookIn:=xlValues, _ LookAt:=xlPart) '---cに検索結果を格納 If Not c Is Nothing Then '---条件に当てはまるセルがあれば Range(Out_都市名IC & Out_Cnt).Font.ColorIndex = .c.Offset(0,1).Value Range(Out_都市名IC & Out_Cnt).Interior.ColorIndex = .c.Offset(0,2).Value    End If  End With ・・・と云った感じで 考えてみてください。詳しくは http://www.moug.net/tech/exvba/0050116.htm 参照してください。

  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.2

>条件だけを登録(他のシート?)できてそこから抜き出せるプログラムにできないか あるブック.xlsのあるシートのA1:A130に「条件」を羅列してあるとすると。 作成例: if application.worksheetfunction.countif(workbooks("あるブック.xls").worksheets("あるシート").range("A1:A130"), Range(Out_都市名IC & Out_Cnt).Value) > 0 then  'ありました。  Range(Out_都市名IC & Out_Cnt).Font.Bold = True  Range(Out_都市名IC & Out_Cnt).Font.ColorIndex = 41  Range(Out_都市名IC & Out_Cnt).Interior.ColorIndex = 34  Range(Out_都市名IC & Out_Cnt).Interior.Pattern = xlSolid end if 具体的にどのように組み立てたら「あるブック」だの「あるシート」だのが,いまあなたが宿題を貰った使用目的で「使いやすく」なるのか考えて,工夫して実装してみてください。

  • bin-chan
  • ベストアンサー率33% (1403/4213)
回答No.1

if で orを使って複数記述するとか、またはselect case文を使うとか。 select cade Range(Out_都市名IC & Out_Cnt).Value case "松山市", "函館市": '好きなだけ書いてください。行末に半角スペースと_を入れると次行に継続可能  Range(Out_都市名IC & Out_Cnt).Font.Bold = True  Range(Out_都市名IC & Out_Cnt).Font.ColorIndex = 41  Range(Out_都市名IC & Out_Cnt).Interior.ColorIndex = 34  Range(Out_都市名IC & Out_Cnt).Interior.Pattern = xlSolid case else   'その他の場合 end select

syoutan
質問者

補足

条件として130個あるので。。。 他にないでしょうか?

関連するQ&A

  • エクセルVBAについて

    エクセルVBA初心者で、勉強中の者です。 添付画像のような時間のグラフのようなものを作りたいと思っています。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub 時間グラフ作成() If Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value = CDate("9:05") Then Worksheets("(2)(2)(2)(2)").Range("I2").Select  With Selection.Interior   .ColorIndex = 8   .Pattern = xlSolid  End With Elseif Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value = CDate("9:10") Then Worksheets("(2)(2)(2)(2)").Range("J2").Select  With Selection.Interior   .ColorIndex = 8   .Pattern = xlSolid  End With  ・  ・   ・ End If End Sub 'それから、終了の時間を入れて、開始から終了までの間を塗りつぶす。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 以上のように作成しようと考えていましたが、いざやろうとすると 1行に対してあまりにも膨大な記述をしなくてはならないことに 気がつきました(一月分ともなると恐ろしいです・・・)・・・。 もっと効率的な方法はあるものでしょうか? よろしくお願いいたします。

  • エクセル VBAで

    変動する数値が、セル A1に入る状況で、 該当シートに Private Sub Worksheet_Change(ByVal Target As Range) If Range("A1").Value = 1 Then Range("C62").Value = "○" ElseIf Range("A1").Value = 2 Then Range("C62:C63").Value = "○" ElseIf Range("A1").Value = 3 Then Range("C62:C64").Value = "○" ElseIf Range("A1").Value = 4 Then Range("C62:C65").Value = "○" ElseIf Range("A1").Value = 5 Then Range("C62:C66").Value = "○" ElseIf Range("A1").Value = 6 Then Range("C62:C67").Value = "○" ElseIf Range("A1").Value = 7 Then Range("C62:C68").Value = "○" ElseIf Range("A1").Value = 8 Then Range("C62:C69").Value = "○" ElseIf Range("A1").Value = 9 Then Range("C62:C70").Value = "○" ElseIf Range("A1").Value = 10 Then Range("C62:C71").Value = "○" ElseIf Range("A1").Value = 11 Then Range("C62:C72").Value = "○" ElseIf Range("A1").Value = 12 Then Range("C62:C73").Value = "○" ElseIf Range("A1").Value = 13 Then Range("C62:C74").Value = "○" ElseIf Range("A1").Value = 14 Then Range("C62:C75").Value = "○" ElseIf Range("A1").Value = 15 Then Range("C62:C76").Value = "○" End If End Sub と言ったマクロを記述しましたが、 動作がどうにも重くて困っています。 一度、プレビューをした後は特に遅くなります。 何か良い解決方法はありますでしょうか?

  • コンパイルエラー「プロシージャが大きすぎます」とのエラーが出ます

    セルに入力する値によって、重複した場合にセルの色が変化するようにVBAで記述しましたが、設定した行数が多すぎて、コンパイルエラー「プロシージャが大きすぎます」とのエラーが出ます。小さく記述するにはどの様に書いたらよいでしょうか?ご指導お願いいたします。 記述したVBAは下記とおりです。約35行ほどでエラーです。 Private Sub Worksheet_Change(ByVal Target As Range) Set myRng = Range("B2") '2行目の設定 For Each c In myRng If c.Value = "" Then c.Interior.ColorIndex = 2 'B2が空白ならばセルの色を白色 ElseIf c.Value = Range("I2") Then c.Interior.ColorIndex = 3 'B2=I2ならばセルの色を赤色 ElseIf c.Value = Range("J2") Then c.Interior.ColorIndex = 6 'B2=J2ならばセルの色を黄色 ElseIf c.Value = Range("K2") Then c.Interior.ColorIndex = 6 'B2=K2ならばセルの色を黄色 ElseIf c.Value = Range("L2") Then c.Interior.ColorIndex = 8 'B2=L2ならばセルの色を青色 ElseIf c.Value = Range("M2") Then c.Interior.ColorIndex = 8 'B2=M2ならばセルの色を青色 Else c.Interior.ColorIndex = xINone End If Next c Set myRng = Range("C2") '2行目の設定 For Each c In myRng If c.Value = "" Then c.Interior.ColorIndex = 2 'C2が空白ならばセルの色を白色 ElseIf c.Value = Range("I2") Then c.Interior.ColorIndex = 6 'C2=I2ならばセルの色を黄色 ElseIf c.Value = Range("J2") Then c.Interior.ColorIndex = 6 'C2=J2ならばセルの色を黄色 ElseIf c.Value = Range("K2") Then c.Interior.ColorIndex = 6 'C2=K2ならばセルの色を黄色 ElseIf c.Value = Range("L2") Then c.Interior.ColorIndex = 8 'C2=L2ならばセルの色を青色 ElseIf c.Value = Range("M2") Then c.Interior.ColorIndex = 8 'C2=M2ならばセルの色を青色 Else c.Interior.ColorIndex = xINone End If Next c Set myRng = Range("D2") '2行目の設定 For Each c In myRng If c.Value = "" Then c.Interior.ColorIndex = 2 'D2が空白ならばセルの色を白色 ElseIf c.Value = Range("I2") Then c.Interior.ColorIndex = 6 'D2=I2ならばセルの色を黄色 ElseIf c.Value = Range("J2") Then c.Interior.ColorIndex = 6 'D2=J2ならばセルの色を黄色 ElseIf c.Value = Range("K2") Then c.Interior.ColorIndex = 6 'D2=K2ならばセルの色を黄色 ElseIf c.Value = Range("L2") Then c.Interior.ColorIndex = 8 'D2=L2ならばセルの色を青色 ElseIf c.Value = Range("M2") Then c.Interior.ColorIndex = 8 'D2=M2ならばセルの色を青色 Else c.Interior.ColorIndex = xINone End If Next c      ・      ・ End Sub

  • エクセルVBAでクリックしたセルのみ書式を変えたいのです。

    Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Target.Row <= 11 And Target.Column <= 11 Then With Selection .Interior.ColorIndex = 3 .Font.ColorIndex = 2 .Font.Bold = True End With End If End Sub これで出来るのですが、問題は別のセルに移動しても書式は変ったままなのです。(当り前ですが) 書式を変えるのはあくまで選択されている間だけにしたいのです。 どのようにすればよいのでしょうか? エクセル97です。

  • エクセルVBAについて

    エクセルVBA初心者で、勉強している者です。 今、ガントチャートのようなものを作っているのですが、 下記のような記述をしたのですがうまく動きません。 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub 時間グラフ作成() If Worksheets("(1)(1)(1)(1)(1)").Range("F2").Value = "10:00" Then Worksheets("(2)(2)(2)(2)").Range("T2").Select With Selection.Interior .ColorIndex = 8 .Pattern = xlSolid End With End If End Sub ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ F2のセルを空にし、「""」で実行すると動きました。 色々調べてみたものの、煮詰まってしまいました・・・。 よろしくお願いいたします。

  • エクセルVBA 前回のご回答で質問です

    http://oshiete1.goo.ne.jp/qa3764996.html 前回上の質問をさせていただき、お二方から大変よいご回答をいただきました。 これを勉強したいと思い、読み取ろうとしたのですが、理解できないところがあり、日本語にすればどのようになるのかお教えいただきたいと思い、質問にまた参りました。分からないところは、下の全コード中の、 r.Offset(0, -1).Resize(1, 2).Interior.ColorIndex = trg.Interior.ColorIndex '    r.Offset(0, -1).Resize(1, 2).Font.ColorIndex = trg.Font.ColorIndex の部分です。OffsetとResizeでの行、列の方向性が理解できないのです。よろしければコメントを着けていただければ助かります。 よろしくお願いします。 Sub Macro1() Dim r, trg As Range  For Each r In Range("B4:AD27")   If r.Value <> "" Then    Set trg = Range("B1:O1").Find(what:=r.Value, LookIn:=xlValues, lookat:=xlWhole)    If Not trg Is Nothing Then     r.Offset(0, -1).Resize(1, 2).Interior.ColorIndex = trg.Interior.ColorIndex '    r.Offset(0, -1).Resize(1, 2).Font.ColorIndex = trg.Font.ColorIndex    End If   End If  Next r End Sub

  • エクセルVBAのオプションボタンがうまくいきません 

    エクセルのVBAでフォームをつくり 3つのオプションボタンを配置し チェックした項目のとき、指定したセルに「レ」の印を書き込ませたいのですが、うまくいきません。 同じフォーム内のテキストボックスやコンボボックスの内容はうまくセルに書き込めるのですが・・・ オプションボタンのグループは設定してあります。 下のように記述したのですが、なぜ思うように動作しないか教えてください。 If オプション(3) = True Then ActiveCell.Value = "レ" ElseIf オプション(1) = True Then Range("H21").Value = "レ" ElseIf オプション(2) = True Then Range("H23").Value = "レ" End If

  • VBAでの計算後のセルに2重線で囲む

    まだPC・VBA不慣れな為、実行できないので、教えてください。 c16セルに休日を入力すると無理つぶしは成功しましたが、c16セルに祭日を入力すると赤の2重線で囲みたいのですが、できませんので、方法をお願いします。 もう1点がCELLS・RANGEを使った2種類の方法をお願いします。 よろしくお願いします。 Sub 練習44() Dim kyuyo As Currency If Range("c16").Value = "祭日" Then Worksheets("練習1If~Then").Cells(16, 3).xlDouble.ColorIndex = 3 ElseIf Range("c16").Value = "休日" Then Worksheets("練習1If~Then").Cells(16, 3).Interior.ColorIndex = 5 Else Worksheets("練習1If~Then").Cells(16, 3).Interior.ColorIndex = 10 End If End Sub

  • エクセルのVBAを教えて下さい。

    Private Sub OptionButton1_Click() Range("A15").Select Selection.Font.ColorIndex = 1 Range("B12").Select Selection.Font.ColorIndex = 1 Range("A18").Select Selection.Font.ColorIndex = 2 Range("B18").Select Selection.Font.ColorIndex = 2 Sheets("シート1").Image1.Visible = False Sheets("シート1").Image2.Visible = True End Sub 上記のようなプログラムがありますが、たとえば、以下をまとめてコンパクトに出来ますか? Range("A15").Select Selection.Font.ColorIndex = 1 Range("B12").Select Selection.Font.ColorIndex = 1 オートシェイプを利用して画像をエクセル内に作りました。 その画像を表示、非表示させたいのですが、どのようにすればよいでしょうか?よろしくお願いします。

  • エクセルVBAのイベントで質問です。

    ある範囲のセルの色をダブルクリックにより変えていますが、 下の("D5:D50,F5:F50,K5:K50,M5:M50"))の範囲を例えばSheet1の A2以下に始めの範囲、B2以下に終りの範囲を下に書いていって、 対象とする範囲を可変にしたいのですが、どのようにすれば いいでしょうか。 例えば("D5:D50,F5:F50,K5:K50,M5:M50"))であれば A2に「D5」 B2に「D50」 A3に「F5」 B3に「F50」 などとセルにセル番地をいれておいて、コードを変えなくても シート上で範囲を変えていけるようにできないでしょうか。 やり方があれば教えてください。 よろしくお願いします。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim r As Range Set r = Intersect(Target, Range("D5:D50,F5:F50,K5:K50,M5:M50")) If r Is Nothing Then Exit Sub With r.Interior If .ColorIndex = xlNone Then .ColorIndex = 3 ElseIf .ColorIndex = 3 Then .ColorIndex = 4 ElseIf .ColorIndex = 4 Then .ColorIndex = xlNone End If End With Cancel = True End Sub

専門家に質問してみよう