人に聞けない痔の悩み、これでスッキリ >>

リスト表と一覧表の2つの表があるとします。
例えば。
リストの中に下記が入力されています。
ああああ
いいいい
うううう
ええええ
おおおお
このリストを参照して
一覧表にも“ああああ”があったら
その文字を赤くする。
このマクロの組み方を教えてください。
宜しくお願いします。

「VBA リストを参照して文字色を変える」の質問画像

このQ&Aに関連する最新のQ&A

A 回答 (6件)

こんにちは。

 FarEyesです。

> この後の作業は
> どうしたら良いのでしょうか??
> (赤くさせる為には…)
>
> 今まではオブジェクトにマクロを登録して
> ポッチで実行させてたんですが
> その方法で出来ますか??

今回のマクロは、「標準モジュール」に作成するようなマクロ(引数なしの関数形式のもの)
のように、「マクロ実行ボタン」から実行するようなマクロではありません。

今回のマクロは、シート上の、
  ・セルに値(文字列)を入れた時。
  ・セルの値(文字列)を変更した時。(同じ値を入れた場合も含む)
のタイミングに発生する、『セルの値が変更された』というイベント(Excelがシート
オブジェクトに対して送る通知)を、シートオブジェクトが受け取った時に、実行され
るマクロです。(※ワークシートのイベントプロシージャという種類のマクロです。)
(※少し専門的で難しい話しなので、今は理解されなくても構いません。)

要するに、「セルに値を入れた時」、及び、「セルの値を変更した時」に、実行される
マクロです。

ですので、今回のマクロは、既にセルに入っている値(文字列)に対しては、適用
されません。
既存のセルの文字色を変更する(赤くさせる)ためには、「一覧表」側のセルの値
(文字列)を、『もう一度入れ直す』(同じ値を入れる)必要があります。

「一覧表」側のセルの値(文字列)を入れ直す(同じ値を入れる)には、
  1)「一覧表」側の先頭のセル(一番上の行のセル)を選択します。
    ・マウスのワンクリックで選択状態にします。
  2)ファンクションキーの[F2]キーを押します。
    ・これで、セルの値が入力(変更)できる状態になります。
    ・セル内のカーソル位置は、「文字列」の後の一番右端にあると思います。
  3)そのまま、[Enter]キーを押します。
    ・これで、セルの選択状態が次の行のセル(標準の設定ならば)に移動します。
    ・この際、入力した文字列が、「リスト」側に登録してあれば、文字色が「赤」色
     で表示される筈です。(※これで、マクロが正常に実行されたということです。)
  4)上記3)で、セルの選択位置が次の行に移動したら、上記2)~3)の操作を
    「一覧表」セルの終端(最後の行)まで繰り返します。
以上のような操作を行って下さい。
※もっと簡単な方法があるかもしれませんが、取りあえず思い浮かんだ操作です。

「一覧表」側セルの行範囲を拡張(下方向への行追加)を行った際の、最後の空欄
セルから下方向に、新たに「文字列」を追加していく際にも、マクロは適用されると
思います。
※マクロの設定では、シートの最終行(F列のみ)までカバーするようにしています。

■補足
今回の件とは、直接関係ない話しなので、以下は蛇足になりますが、
どうやら、質問者さんは、Excel VBAの基本的なことから学ばれた方がよさそう
ですので、参考になりそうなサイトを紹介致します。

<参考サイト>
◎Excel VBA 入門講座
http://excelvba.pc-users.net/

◎Excel(エクセル)VBA入門
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/i …

できれば、Excel VBA関係の「入門書」なり「解説書」なりを一冊、ご用意されて
その中に掲載されているサンプルマクロなどを、実際に自分で入力&実行して
試してみる作業を、繰り返し行ってみて下さい。
そして、作成したマクロを適当にいじってみて下さい。
※エラーが出ても構いません。原因はそのうち解ってくると思います。

以上のような作業が、手っ取り早い学習方法かもしれません。

最初は何をやっているか理解できなくても構いません。
とにかく、実際の動作を『体感』してみるのが良い経験になるかと思います。
⇒『習うより、慣れろ』です。

以上です。
    • good
    • 0
この回答へのお礼

FarEyes様
何度も何度もありがとうございました。
自分でも色々試して見ます。
また何かあった時は宜しくお願いします。
初心者の私に親切にして頂いてありがとうございました。

お礼日時:2009/12/06 15:29

こんにちは。

 FarEyesです。

ひょっとして、「標準モジュール」にコピぺされていませんか?

今回のマクロは、「標準モジュール」ではなく、ワークシート側のコードモジュールに
実装するマクロです。

以下の操作を行って下さい。

1)VBE画面で、画面左側に「プロジェクトエクスプローラ」のツリー画面が表示されて
  いると思いますが、
  もしも、表示されていなければ、
    「表示」 → 「プロジェクトエクスプローラ」
  をクリックして表示させて下さい。

2)その中に、「VBAProject(Excelブックのファイル名)」のように書かれているもの
  があると思います。
  ※その部分をダブルクリックすると、ツリーが展開されると思います。

3)そのツリーの中に、「Sheet1(シート名)」とか「Sheet2(シート名)」のように書か
  れているものがあると思います。
  ※これが、ワークシートのコードモジュールで、ワークシートと1対1に対応して
   います。

4)この「プロジェクトエクスプローラ」のツリー内の、対象シート(「リスト」のセル及び
 「一覧表」のセルを設定したワークシート)に対応した、シートのコードモジュールを
 ダブルクリックすると画面の右側に、「コード画面」が表示されると思います。

5)この「コード画面」に、#3のコードを、「そのまま」貼り付けて下さい。

/////↓ここから//////////
Option Explicit
'
'== シートのセルの値変更時のイベント処理 ==
Private Sub Worksheet_Change(ByVal Target As Range)
    :
    :
End Sub
/////↑ここまで//////////

※もしも、"Option Explicit"の行が、既にあった場合は、コピペした側の1行を
 削除して、1箇所のみにして下さい。

6)それから、「標準モジュール」にコピペしたコードは、全て削除して下さい。

7)VBEの画面で、「デバッグ」→「VBA Projectのコンパイル」でコンパイルを
  行ってみて下さい。
  ※もしも、ここで何かしらのエラーが表示された場合は、
     「エラー発生箇所のコード内容」 と 「表示されたエラーメッセージ」
   を、ご報告願えないでしょうか?
   もしくは、「ヘルプ」などを参照して、ご自身でエラーを修正して下さい。

8)上記7)で何もエラーが表示されなかった場合は、Excelのシート画面に
  戻って下さい。

9)念のため、ここで一旦、Excelブックを「保存」して下さい。

10)ワークシートの「一覧表」のセルに、適当な文字列を入れて[Enter]キー
  を押して下さい。
  ※これで、セル更新のイベントが発生し、マクロが実行されると思います。
  ※ここで、もしも、エラーが発生し場合は、
     「エラー発生箇所のコード内容」 と 「表示されたエラーメッセージ」
   を、ご報告願えないでしょうか?
   もしくは、「ヘルプ」などを参照して、ご自身でエラーを修正して下さい。

※添付画像は、VBE画面をキャプチャしたものです。

以上です。
「VBA リストを参照して文字色を変える」の回答画像5

この回答への補足

ありがとうございます。
エラーなく貼付けが出来ました。
セルに文字を入れてもエラーは出ませんでした。

この後の作業は
どうしたら良いのでしょうか??
(赤くさせる為には…)

今まではオブジェクトにマクロを登録して
ポッチで実行させてたんですが
その方法で出来ますか??

無知で申し訳ありません。

補足日時:2009/12/06 11:24
    • good
    • 0

こんにちは。

 FarEyesです。

> そのままコピーぺしてやってみました。

何処に(どのモジュールに?)コピーされたのでしょう?

#3の改造前のExcelブック(#2のコードが実装された時点のExcelブック)にコピー
されたのでしょうか?
その場合、改造前のコードを「全て削除」した上でコピーされたのでしょうか?
昔のコードが残っていて重複しているような部分はないでしょうか?

※マクロコードなどを修正・改造する場合は、修正前のExcelブックはそのままに
 しておいて、別ファイルとしてExcelブックを保存してから修正を加えるか、新しい
 Excelブックを作成し、そこに旧コードをコピー&ペーストして修正を加えるように
 した方が良いと思います。

こちらでは、ご提示のエラーが再現できないので、原因がつかめないのですが、
念のため、以下の操作を行ってみて下さい。

1)Excelを起動して、「ファイル」→「新規作成」で、新しいブック(何も手を加えて
  いない、まっさらなExcelブック)を作成して下さい。

2)作成したブックで、「Visual Basic Editor(VBE)」を起動して、シート1(Sheet1)
  のコードモジュールへ、#3のコードをコピー&ペーストして貼り付けて下さい。

3)VBEの画面で、「デバッグ」→「VBA Projectのコンパイル」でコンパイルを
  行ってみて下さい。
  ※もしも、ここで何かしらのエラーが表示された場合は、
     「エラー発生箇所のコード内容」 と 「表示されたエラーメッセージ」
   を、ご報告願えないでしょうか?
   もしくは、「ヘルプ」などを参照して、ご自身でエラーを修正して下さい。

4)上記3)で何もエラーが表示されなかった場合は、VBE画面を閉じて、Excelの
  シート画面に戻って下さい。

5)シート1(Sheet1)に、必要な「リスト」データと、「一覧表」の枠のみ(※ここ
  では、まだデータは記入しない)を作成して下さい。

6)ここで、一旦Excelブックを、「名前を付けて保存」で保存したのち、続けて、
  Excelを終了させて下さい。
  ※他のExcelブックを開いていた場合は、そのブックも終了させて下さい。
   (Excelが完全に起動されていない状態にします。)

7)上記6)で保存したExcelブックを、再び開いて下さい。
  ※この際、マクロを有効にして下さい。

8)シート1(Sheet1)の「一覧表」のセルに、適当な文字列を入れて[Enter]キー
  を押して下さい。
  ※これで、セル更新のイベントが発生し、マクロが実行されると思います。
  ※ここで、もしも、エラーが発生し場合は、
     「エラー発生箇所のコード内容」 と 「表示されたエラーメッセージ」
   を、ご報告願えないでしょうか?
   もしくは、「ヘルプ」などを参照して、ご自身でエラーを修正して下さい。

以上です。

この回答への補足

本当にお手数をお掛けして申し訳ありません。
はじめてVBAを言葉を聞いたばかりなのに
会社でマクロの作成を迫られまして。。。
ごめんなさい。

コピペしたときはマッサラなところから始めたので
上書きなどはしてません。

色々試したエラーをお伝えしたいと思います。

●そのまま(Option ExplicitからEnd Subまで)して
《F8》を押すとただエラーの音がするだけでした。

●Option Explicitだけを消してらSub sample1()を投入したら
End Subが必要ですというエラーが出ました。

●Private Sub Worksheet_Change(ByVal Target As Range)に
'コメント(反映しないように)したら
If Intersect(Target, Range("$F4:$F" & Rows.Count)) Is Nothing Then  がエラーになりました。

●あとは色々いじってる間に気がついたのは
“Target”がいつもエラーになってました。

※〔ツール〕→〔オプション〕→〔変数の宣言を強制する〕の
レ点は外してあります。

上手く説明できなくて申し訳ありません。
お手数をお掛けしますが宜しくお願いします。

補足日時:2009/12/06 00:23
    • good
    • 0

こんにちは。

 #2です。

> この方法は文字が一致した場合ですが
> 一部の文字があった場合も赤くするには
> どうしたら良いのでしょうか??

ご要望を解釈しますと、
  「一覧表」側に入れた「文字列」
の中に、
  「リスト」側に登録した「文字列」
が『含まれていた場合』に、「文字色を変更する」ということでしょうか?

言い換えますと、例えば、「リスト」側に、
  そば
という「文字列」が登録されていた場合で、「一覧表」側に、
  そば
と入れた場合でも、
  ざるそば
と入れた場合でも、
  そばつゆ
と入れた場合でも、「文字色を変更する」ということでしょうか?

そうであった場合ですが、文字列の比較の際に、「Like演算子」を使用すれば
対応可能かと思います。

#2のマクロに、上記の改造を行ったものを掲載致します。
変更箇所は、見ていただければ解るかと思います。
※コード内の、"@1"とコメントしてある部分が、追加&変更した箇所です。

■改造後のマクロ
注)インデント等のため全角スペースを入れています。
=========================
Option Explicit
'
'== シートのセルの値変更時のイベント処理 ==
Private Sub Worksheet_Change(ByVal Target As Range)

  Dim nListEnd As Long  '「リスト」側のセル範囲の最終行の位置
  Dim rgList As Range   '「リスト」側のセルオブジェクト取得用
  Dim bFind As Boolean  '一致文字列の「あり/なし」判定フラグ
  Dim sPattern As String '一致文字列を含む検索文字列(@1:追加)

  '入力セルが「一覧表」側のセル範囲にあるかチェック
  '※ここでの「一覧表」側のセル範囲の最終行はシートの最終行に設定しています。
  If Intersect(Target, Range("$F4:$F" & Rows.Count)) Is Nothing Then
    Exit Sub 'なければ戻る
  End If

  '入力セルが「空き」かチェック
  If Target.Text = "" Then
    Exit Sub '「空き」なら戻る
  End If

  '「リスト」側のセル範囲の最終行の位置を取得
  nListEnd = Range("$B" & Rows.Count).End(xlUp).Row

  '「リスト」側のセル範囲をループして一致する文字列を含んでいるかを
  'チェックする
  bFind = False     '一致フラグを「なし」で初期化
  For Each rgList In Range("$B4:$B" & nListEnd)
    sPattern = "*" & rgList.Text & "*" '検索文字列を作成(@1:追加)
    If Target.Text Like sPattern Then  '文字列の比較(@1:変更)
      '入力セルの文字列が「リスト」内の文字列を含んでいた場合
      bFind = True '一致フラグを「あり」とする
      Exit For   'ここでループを抜ける
    End If
  Next

  '一致の「あり/なし」により入力セルのフォント色を設定
  '※色番号は、標準のカラーパレットのカラーインデックス番号を使用しています。
  If bFind = True Then
    '一致あり(リスト内に同一文字列があった)の場合
    Target.Font.ColorIndex = 3 'フォントの表示色を「赤」に設定
  Else
    '一致なし(リスト内に同一文字列がなかった)の場合
    Target.Font.ColorIndex = 1 'フォントの表示色を「黒」に設定
  End If

End Sub
=========================

参考までに、上記改造後のシート画面のキャプチャ画像を添付しています。

以上です。
「VBA リストを参照して文字色を変える」の回答画像3

この回答への補足

ありがとうございます。

そのままコピーぺしてやってみました。

実行時エラー'424'
オブジェクトが必要です。

となってしまいました。
エラーが出てる箇所は
If Intersect(Target, Range("$F4:$F" & Rows.Count)) Is Nothing Then です。

朝最初に回答いただいたのをやってみた時は出来たのですが…。

'コメントにしてみたら
次のIfのところでもエラーが出てしまいました。

何度も何度も申し訳ありません。
改善方法を教えてください。
宜しくお願いします。

補足日時:2009/12/05 18:58
    • good
    • 0

こんにちは。



当方もマクロの一例を作成してみました。

#1さんご提示の2番目の方法と同じく、一覧表側のセルの値が変更
された際のイベント処理による方法です。

■サンプルマクロ
注)インデント等のため全角スペースを入れています。

※以下のコードは、対象シートのコードモジュールに貼り付けて下さい。
※コード内の「リスト」側のセル範囲及び、「一覧表」側のセル範囲は、
 ご使用の環境に合わせて、適せん変更して下さい。
=========================
Option Explicit
'
'== シートのセルの値変更時のイベント処理 ==
Private Sub Worksheet_Change(ByVal Target As Range)

  Dim nListEnd As Long '「リスト」側のセル範囲の最終行の位置
  Dim rgList As Range  '「リスト」側のセルオブジェクト取得用
  Dim bFind As Boolean '一致文字列の「あり/なし」判定フラグ

  '入力セルが「一覧表」側のセル範囲にあるかチェック
  '※ここでの「一覧表」側のセル範囲の最終行はシートの最終行に設定しています。
  If Intersect(Target, Range("$F4:$F" & Rows.Count)) Is Nothing Then
    Exit Sub 'なければ戻る
  End If

  '入力セルが「空き」かチェック
  If Target.Text = "" Then
    Exit Sub '「空き」なら戻る
  End If

  '「リスト」側のセル範囲の最終行の位置を取得
  nListEnd = Range("$B" & Rows.Count).End(xlUp).Row

  '「リスト」側のセル範囲をループして一致する文字列があるかチェック
  bFind = False     '一致フラグを「なし」で初期化
  For Each rgList In Range("$B4:$B" & nListEnd)
    If Target.Text = rgList.Text Then
      '入力セルの文字列が「リスト」内の文字列と一致した場合
      bFind = True '一致フラグを「あり」とする
      Exit For   'ここでループを抜ける
    End If
  Next

  '一致の「あり/なし」により入力セルのフォント色を設定
  '※色番号は、標準のカラーパレットのカラーインデックス番号を使用しています。
  If bFind = True Then
    '一致あり(リスト内に同一文字列があった)の場合
    Target.Font.ColorIndex = 3 'フォントの表示色を「赤」に設定
  Else
    '一致なし(リスト内に同一文字列がなかった)の場合
    Target.Font.ColorIndex = 1 'フォントの表示色を「黒」に設定
  End If

End Sub
=========================

因みに、今回の処理は、マクロを使用しなくても、ワークシート側の「条件付き書式」
の設定による方法でも対応可能だと思います。

以下は、その設定方法の一例です。

■「条件付き書式」設定による設定手順
注)Excelのバージョンにより、操作方法などが違う場合があります。
  ※当方は、Excel2000で試してみました。

1)色を付けたい側(「一覧表」側)のセル範囲を選択します。
  ご提示の画像の場合、F4~F13 のセル範囲になります。

2)メニュー操作
  「書式」 → 「条件付き書式」 をクリックします。

3)「条件付き書式の設定」のダイアログ画面の操作
 ◎条件1の設定
  ・左端のコンボボックスのリストより、「数式が」を選択
  ・その右横の「数式」の欄に、下記の数式を設定
    =ISERROR(MATCH(F4,$B$4:$B$65536,0))=FALSE
    ※"$B$4:$B$65536" の部分は、「リスト」側のセル範囲を指定します。
  ・[書式]ボタンをクリック
    ・表示された「セルの書式設定」ダイアログ画面の、[フォント]タブを選択
     して、フォントの「色」を、表示させたい色に設定します。
    ・[OK]ボタンをクリックします。
  ・元のダイアログ画面に戻ったら、[OK]ボタンをクリックしてダイアログを閉じ
   ます。

以上で、設定完了です。
※添付画像は、上記の「条件付き書式の設定」画面のキャプチャ画像です。

以上です。参考になれば幸いです。
「VBA リストを参照して文字色を変える」の回答画像2

この回答への補足

ありがとうございます。
もう1つお聞きしたい事があります。
この方法は文字が一致した場合ですが
一部の文字があった場合も赤くするには
どうしたら良いのでしょうか??
↓↓
bFind = False
修正すれば良いですか??

すみません。
VBAをはじめたばかりなので…
宜しくお願いします。

補足日時:2009/12/05 09:59
    • good
    • 0

簡単な作りですが多分動くと思われます。


一覧の行数が多いときは画面更新のコメントを解除してください。
Sub リストを参照して文字色を変える()
On Error Resume Next
'Application.ScreenUpdating = False
Dim Ret As Long
Dim I As Long
I = 4
Do While Range("F" & I).Value <> ""
Ret = 0
Ret = Application.WorksheetFunction.Match(Range("F" & I).Value, Range("B4:B12").Value, 0)
'リストの行数が増える場合は↑変更必要
If Ret = 1 Then
Range("F" & I).Font.ColorIndex = 3
Else
Range("F" & I).Font.ColorIndex = 0
End If
I = I + 1
Loop
'Application.ScreenUpdating = True
End Sub
別の方法で一覧の入力時に色を付ける場合は↓
Private Sub Worksheet_Change(ByVal Target As Range)
'リスト・一覧の行数が増えてもメンテナンスフリー
Dim I As Long
I = 4
If Target.Column = 6 Then 'F列=6
Target.Font.ColorIndex = 0
Do While Range("B" & I).Value <> ""
If Range("B" & I).Value = Target.Value Then
Target.Font.ColorIndex = 3
Exit Sub
End If
I = I + 1
Loop
End If
End Sub
で、如何でしょうか?
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QEXCEL VBA で特定の文字に色をつけるマクロを書きたいのですが

コードはどのように書けばよいのでしょうか?

(1)そのようなコードを持っていらっしゃったらいただけないでしょうか?

(2)または、参考になるページがありましたら教えていただけないでしょうか?

現在勉強を始めたところですが、よろしくお願いいたします。

Aベストアンサー

セルの文字列の中に,
たとえば
aaaeeessseee
ssddd
dfg
weeeff
のセルの中の
eeeに赤色文字にする。
セル範囲Range("A1:C6")を対象にしてます。
ーーーー
Sub test01()
Dim cl As Range
For Each cl In Range("a1:c6")
r = InStr(cl, "eee")
If r <> 0 Then
cl.Characters(r, 3).Font.Color = vbRed
End If
Next
End Sub

Q他シートのある列を検索して一致したらセルに色をつける方法

次のような処理がしたいのですが、Excelの数式に詳しい方、ご教示お願いします。

次の3つのシートが一つのBOOKにあるとします。
■Sheet1
1列目
AAAA
BBBB
CCCC


■Sheet2
1列目
BBBB
:

■Sheet3
1列目
AAAA
CCCC
:

Sheet1の一列目にあるデータについて、Sheet2あるいはSheet3の1列目を検索し一致するものがあれば、Sheet1の一列目の各セルに色をつけるという処理をしたいです。
できれば、Sheet2に一致した場合と、Sheet3に一致した場合とで、色を変えたいです。

よろしくお願いします。

Aベストアンサー

Sheet2のA列全体を選択した状態で、Ctrl+F3を押して「名前の定義」を開き、選択範囲に名前をつける。たとえば sss2 とか。
Sheet3のA列にも同様に sss3 とかの名前をつける。

Sheet1のA1を選択して、書式-条件付き書式で、
条件1
 「数式が」「=COUNTIF(sss2,A1)>0」
 Sheet2にあった場合の書式(色)を設定
条件2
 「数式が」「=COUNTIF(sss3,A1)>0」
 Sheet3にあった場合の書式(色)を設定
にすれば良いです。

Sheet2にもSheet3にもあった場合のことは、考えていません。

Qエクセルで特定文字列に色をつけたいです。

表中の特定の文字列(例「日本」)に色をつけて表示するようにしたいのですが、ひとつひとつ手で変えていくしかないのでしょうか。
よろしくお願いします。

Aベストアンサー

vba処理です

Sub test()
Dim rng As Range, r As Range, i As Long, colInd As Integer
With ActiveSheet
Set rng = .Range("a1:z100") '範囲の設定
txt = "日本" '文字の設定
colInd = 3 '色の設定
For Each r In rng
If InStr(r, txt) > 0 Then _
r.Characters(InStr(r, txt), Len(txt)) _
.Font.ColorIndex = colInd
Next
End With
End Sub

QエクセルVBAで該当するセルに色をつけたい

ご覧いただき、ありがとうございます。
当方、VBA初心者です。

エクセルVBAで、「対象の社名」に該当するセルに色をつけたいと思っています。
それぞれ別シートになります。

たとえば、abc(株)が対象なら、

1.(株)は(株)や株式会社など表記がバラバラなので取る⇒abcの文字列が検索対象
2.「検索シート」にあるabcを検索
3.対象のセルに色をつける
4.文字列がある限り(この場合は○がついている部分はずっと)検索続ける
※○の数式はつけた方が探しやすいと思って作ったので、なくても構いません

わかりづらい文章ですみません。
ぜひお知恵を貸してください><

Aベストアンサー

また追加です 追加ばかりで申し訳ありません

検索範囲がB2から始まってるとしたらこちらも変更してください。

MyBottom = Worksheets("検索シート").Range("A" & Rows.Count).End(xlUp).Row

MyBottom = Worksheets("検索シート").Range("B" & Rows.Count).End(xlUp).Row

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

Qセル色を、ある条件で自動的に色分けして塗りつぶしさせたい

こんにちは。いつもお世話になっております。
まさに標題の通りなのですが、有る位置のセル内に入れた数字によって設定済みの色でセルを
塗りつぶしたい場合、どのようにすれば宜しいでしょうか。
因みに現在は下記の通りに設定しております。


●現在の設定●
書式(D)→条件付き書式(D) にて

条件1(1)
数式が =$G2=1 であればセル色を黄緑

条件2(2)
数式が =$G2=2 であればセル色をピンク

条件3(3)
数式が =$G2=3 であればセル色を水色

◆この度、設定変更しなくてはならない背景◆
来月からセルG2に入れる数字が現状では1,2,3のみですが1,2,3,4,5と変更になる為。
(書式付き設定ではMAX3つまでしか設定できないように見受けられるので)


尚、当方はさほどエクセルに精通しておりませんのでマクロやVBAなど組んだ事が無く、かつ、
以前ちょっと挑戦しようと思ったのですが全く理解できなかった為、例えば関数などを用いて
設定出来る方法がありましたら例文を記載して戴けますと非常に助かります。

また、エクセルのヘルプで検索した結果
「VBAを使用してセルの塗りつぶしの色を変更する」というものを見つけたので閲覧↓
http://office.microsoft.com/ja-jp/excel/HA011366271041.aspx?pid=CL100570551041
したのですが、式らしきものを見つけたものの、その意味が理解できず、どのように記述して
よいのか判りませんでした。。。

以上、お手隙の方、いらっしゃいましたら何卒ご教授の程、お願い致します。

こんにちは。いつもお世話になっております。
まさに標題の通りなのですが、有る位置のセル内に入れた数字によって設定済みの色でセルを
塗りつぶしたい場合、どのようにすれば宜しいでしょうか。
因みに現在は下記の通りに設定しております。


●現在の設定●
書式(D)→条件付き書式(D) にて

条件1(1)
数式が =$G2=1 であればセル色を黄緑

条件2(2)
数式が =$G2=2 であればセル色をピンク

条件3(3)
数式が =$G2=3 であればセル色を水色

◆この度、設定変更しなくてはなら...続きを読む

Aベストアンサー

#02です。補足を見て変更しました。
色番号はご自由に直してください

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r, rng As Range
Const trg As String = "G2:G50" ' "A1:A3"のように複数セルでもよい
 Set rng = Intersect(Target, Range(trg))
 If Not rng Is Nothing Then
  For Each r In rng
   Select Case r.Value
   Case Is = 1 'もし入力されたのが1ならば
    Cells(r.Row, 1).Resize(1, 8).Interior.ColorIndex = 4 '背景色を黄緑
   Case Is = 2 'もし入力されたのが2ならば
    Cells(r.Row, 1).Resize(1, 8).Interior.ColorIndex = 7 '背景色をピンク
   Case Is = 3 'もし入力されたのが3ならば
    Cells(r.Row, 1).Resize(1, 8).Interior.ColorIndex = 8 '背景色を水色
   Case Is = 4 'もし入力されたのが4ならば
    Cells(r.Row, 1).Resize(1, 8).Interior.ColorIndex = 6 '背景色を黄色
   Case Is = 5 'もし入力されたのが5ならば
    Cells(r.Row, 1).Resize(1, 8).Interior.ColorIndex = 3 '背景色を赤
   Case Else 'その他の値なら色を消す
    Cells(r.Row, 1).Resize(1, 8).Interior.ColorIndex = xlNone
   End Select
  Next r
 End If
End Sub

#02です。補足を見て変更しました。
色番号はご自由に直してください

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r, rng As Range
Const trg As String = "G2:G50" ' "A1:A3"のように複数セルでもよい
 Set rng = Intersect(Target, Range(trg))
 If Not rng Is Nothing Then
  For Each r In rng
   Select Case r.Value
   Case Is = 1 'もし入力されたのが1ならば
    Cells(r.Row, 1).Resize(1, 8).Interior.ColorIndex = 4 '背景色を黄緑
   Case Is = 2 '...続きを読む

QEXCELの文字列を指定の色に変えるには

EXCELの例えばA列の文字データの特定の文字列を一括して指定色(例えば赤)に変えるにはどうしたらよいか教えてください。
例:A列の1~1000行の各行に文字データが入力されている。これらのデータの内"ABC"という文字列だけ一括して赤色にかえたい。

Aベストアンサー

>データの内"ABC"という文字列だけ一括して赤色にかえたい
の意味が「ABCという文字列を含むセルは全部赤にしたい」ということであれば「編集」→「置換」→「置換前と後の文字列にABCを指定」→「オプション」→「書式」で文字色を指定できます。

そうではなく、「XXXXABC12334」という文字列の中で「ABC」の部分だけを赤にしたいならマクロが必要です。

以下のマクロをALT+F11でVBE画面を開き、「VBAProjectエクスプローラのシート名右クリック」→「挿入」→「標準モジュール」で表示される画面にペーストして下さい。実行はシート画面に戻って、ALT+F8を押してマクロ一覧からマクロ名を選択して実行します。
Sub Macro1()
Dim rng As Range
Dim ptr As Integer
Const tStr As String = "ABC" 'ここに色を変える文字列を書く
 For Each rng In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 23)
  ptr = InStr(rng.Value, tStr)
  If ptr > 0 Then
   rng.Characters(Start:=ptr, Length:=Len(tStr)).Font.ColorIndex = 3
  End If
 Next rng
End Sub

>データの内"ABC"という文字列だけ一括して赤色にかえたい
の意味が「ABCという文字列を含むセルは全部赤にしたい」ということであれば「編集」→「置換」→「置換前と後の文字列にABCを指定」→「オプション」→「書式」で文字色を指定できます。

そうではなく、「XXXXABC12334」という文字列の中で「ABC」の部分だけを赤にしたいならマクロが必要です。

以下のマクロをALT+F11でVBE画面を開き、「VBAProjectエクスプローラのシート名右クリック」→「挿入」→「標準モジュール」で表示される画面にペース...続きを読む

Q[初心者です]VBAで指定列からAを検索し、発見したら隣のセルに値0を入れるマクロ。

VBAで指定列からAを検索し、発見したら隣のセルに0を入れるマクロを組みたいのですが、組み方がVBA初心者の為わかりません。
(例)
L列に、A、B、C、D、E、Fとランダムに文字が入っていて、
文字Aを検索し、発見したら隣のI列に値0を入れるというマクロです。

Sub Search()
Dim A As String
Set A = Worksheets("Sheet1").Cells.Find("A")
If A Is Nothing Then
ActiveCell.Offset(0, 1).Value = 0

End If
End Sub
と過去の質問で考えてみたのですが、Aがあった時、、、、
とコードが書けないです。
大変困っているので、ご教授頂けないでしょうか?
出来れば、そのままマクロに出来るコードを教えて頂けないでしょうか?
宜しくお願い致します。

Aベストアンサー

こんばんは。

#3さんのおっしゃっていることも、もっともなのですが、気になる点がありましたので、自分のことを踏まえて、書かせていただきます。

いずれ、また、同じようなケースが出会うと思います。こんな原則を考えてみたらどうでしょうか?それは、私も自身も同じなのですが、ワークシートのコマンドで行われるものは、記録マクロから作ってみるということです。他にも、「統合」とか、「置換」とか「オートフィルタ」「フィルタオプション」とかは、みんなパターンが決まっています。
その中の代表格が、この「Find」 です。

>Set A = Worksheets("Sheet1").Cells.Find("A")

>過去の質問で考えてみたのです

どうも、Find メソッドは、あるレベル以下の人は、省略する傾向があるようです。何が大事で、何が大事でないかというのは、やってみなければ分かりませんが、検索語だけを入れる書き方は、実務では、あまりしないほうがよいと思います。

だいたい、以下のTestFind2 ぐらいまでに、省略は、とどめたほうがよいです。

それは、Find は、必ずしも自分が思っているデフォルトとは違うことがあるので、「明示的(意図的に)」にオプションは入れたほうがよいです。
例えば、大文字小文字の違いを付けるなら、MatchCase:=True, 数式まで探すなら、LookIn:=xlFormulas

なお、Find メソッドは、5年経っても、たぶん完全に覚えられません。面倒なコードのひとつです。ですが、これはパターンが決まっているので、ひとつパターンが決まったら、それに当てはめればよいだけです。

#3さんで示されているMougのサンプルコードと似てはいるのですが、Mougのサンプルコードでは、Verionによって、失敗することがあります。

'--------------------------------------
'記録マクロをそのまま使う方法
Sub TestFind1()
Dim c As Range
 Set c = Columns("L:L").Find(What:="A", _
           After:=ActiveCell, _
           LookIn:=xlValues, _
           LookAt:=xlPart, _
           SearchOrder:=xlByRows, _
           SearchDirection:=xlNext, _
           MatchCase:=False, _
           MatchByte:=False, _
           SearchFormat:=False)
 c.Offset(0, 1).Value = 0
End Sub
'--------------------------------------
'TestFind1 をアレンジしてみる
Sub TestFind2()
Dim c As Range
'検索語
Const MYTXT As String = "A"
 Set c = ActiveSheet.Columns("L:L").Find(What:=MYTXT, _
           LookIn:=xlValues, _
           LookAt:=xlPart, _
           MatchCase:=False)
 If Not c Is Nothing Then
    c.Offset(0, 1).Value = 0
 End If
End Sub

'---------------------------------------
'複数ある場合(パターンを使った方法)
'---------------------------------------
Sub TestFind3()
  Dim c As Range
  Dim FirstAdd As String
  Const MYTXT As String = "A"
  Set c = ActiveSheet.Columns("L:L").Find( _
    What:=MYTXT, _
    LookIn:=xlValues, _
    LookAt:=xlPart, _
    MatchCase:=False)
  
  If Not c Is Nothing Then
    FirstAdd = c.Address
    Do
      c.Offset(, 1).Value = 0
      Set c = ActiveSheet.Columns("L:L").FindNext(c)
      If c.Address = FirstAdd Then Exit Sub
    Loop Until c Is Nothing
  End If
End Sub

こんばんは。

#3さんのおっしゃっていることも、もっともなのですが、気になる点がありましたので、自分のことを踏まえて、書かせていただきます。

いずれ、また、同じようなケースが出会うと思います。こんな原則を考えてみたらどうでしょうか?それは、私も自身も同じなのですが、ワークシートのコマンドで行われるものは、記録マクロから作ってみるということです。他にも、「統合」とか、「置換」とか「オートフィルタ」「フィルタオプション」とかは、みんなパターンが決まっています。
その中の代表...続きを読む

QExcel VBA 全てのセルの一部に特定の語句があれば置換したい。

Excel VBA 全てのセルの一部に特定の語句があれば置換したい。
Excel VBA初心者です。
Excelの全てのセルに対して、特定の語句があれば別の特定語句で置換したいのですが、どうしたら良いかわかりません。
全角と半角が混在していますので、これは無視したいですし、変換したい文字列の位置は不定です。Excel 2007です。
取り敢えず、細かなな条件は無視して書いたコードは

Dim myCell As Range
Sub rep()

For Each myCell In Selection
myCell.Value = Replace(myCell.Value, "OLD", "NEW")
Next myCell

End Sub

カーソルのある所は置換されますが、それで終わりです。
ご教授下さい。

Aベストアンサー

Cells.Replace What:="OLD", Replacement:="NEW", LookAt:=xlPart
で全部を一発で変換できると思いますが、For Nextで回しているということは何か他の条件があるからですね?

ならば、一例です。
tom29911954さんご提示のコードは選択した範囲のセルをFor Nextで順に見ていってますが、下記のは選択の有無にかかわらず、文字列が入力されたセルだけを順に見に行ってます。
また、Dim myCell As Rangeの変数宣言は、何か別の目的があってしているならともかく、そうでないならプロシージャの中で宣言します。

Sub rep()
  Dim myCell As Range
  For Each myCell In Cells.SpecialCells(xlCellTypeConstants, xlTextValues)
    myCell.Value = Replace(myCell.Value, "OLD", "NEW")
  Next myCell
End Sub

Qリストと一致する値のセルを塗りつぶしたい。

例えば

A列に
東京都
神奈川県
埼玉県
千葉県
愛知県
大阪府
福岡県

という値が入力されているとします。

次にC列に
東京都
新潟県
大阪府
三重県
広島県
福岡県

という値が入力されているとします。

A列に入力されていて、かつC列にも入力されている値を自動的に赤く塗りたいとき、
どのような操作をすればいいのでしょうか。
この場合ですと東京都と大阪府と福岡県のセルが赤くなります。

条件附き書式と数式を組み合わせると良い気がしますが、
具体的には分かりません。

Aベストアンサー

添付図参照

A1: =COUNTIF(C$1:C$6,A1)


このQ&Aを見た人がよく見るQ&A

このカテゴリの人気Q&Aランキング