- ベストアンサー
G列内の組み合わせを検索する方法
- 全てのシートのG列の中から、指定した組み合わせを含むセルに赤色をつけ、60パーセント以上のセルで一致してたら黄色をつける方法を教えてください。
- 具体的な例として、G1=1、G2=3、G3=5の場合、それぞれのセルを赤色で表示し、G100=1、G101=4、G102=5の場合はそれぞれのセルを黄色で表示する方法が知りたいです。
- また、赤色と黄色のセルが重複する場合には紫色で表示する方法も教えてください。
- tukutukuhosi
- お礼率92% (50/54)
- その他MS Office製品
- 回答数2
- ありがとう数2
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (1)
- ken-nosuke
- ベストアンサー率36% (56/154)
VBAを使わない方法でやってみました。 1)I1～I3に検索したい文字１，３，５を入力 2)G4～に判定したい文字を入力 3)I4～に下記式を入力 I4: =IF(G2=$I$1,1,0)+IF(G3=$I$2,1,0)+IF(G4=$I$3,1,0) J4: =IF(G3=$I$1,1,0)+IF(G4=$I$2,1,0)+IF(G5=$I$3,1,0) K4: =IF(G4=$I$1,1,0)+IF(G5=$I$2,1,0)+IF(G6=$I$3,1,0) L4: =IF(COUNTIF(I4:K4,3)>0,3,0) M4: =IF(COUNTIF(I4:K4,2)>0,2,0) N4: =L4+M4 4)I4～N4をコピーしI5から下に貼り付け 5)G4の条件付き書式に次の式を設定 条件式 書式 第1条件：＝N4=3 背景「赤」 第2条件：＝N4=2 背景「青」 第3条件：＝N5=5 背景「紫」 注） G1～G3は、空白にしておくこと I4～Mxxは、計算領域。見せたくなければ、文字色を「白」すればOK 各式の意味は、勉強してください。 以上、何の役に立つかわかりませんが、自分の訓練の為やってみました。
お礼
ご回答有難うございます。エクセルは2011でVBAの方がありがたいですが、（毎回全てのシートで実行するので）教えていただいた関数をそのままFomulaでマクロにすれば何とかいけるかもしれないのでとりあえずやってみます。 なお、自分で考えたのは x = 最大行 For i = 1 to x If Cells(i,"G").Value = 1 and Cells(i +1 "G").Value = 3 and Cells (i +2 "G"). Value = 5 then セルを赤 みたいなやつですが、結果が出るまで時間がかかりそうだったのでボツにしました。
関連するQ&A
- マクロ：データの抽出（複数条件）
エクセルで以下のようなマクロを作成しました。 シート1のG列がシート2のF4と合致する時、シート2のＣ列にシート1のＢ列を貼り付けるのですが、条件を増やし 「シート1Ｇ列がシート2のＦ４と一致」かつ「シート1Ｈ列がシート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
- ベストアンサー
- オフィス系ソフト
- Excel VBA でテキストボックスの値をセルA列から検索
いつもお世話になります。 Private Sub CommandButton3_Click() Dim 行 As String Dim 列 As String Dim 最終行 As String Dim 検索行 As String Dim メッセージ As Integer Dim 一致 As Range Dim myNO As Variant Dim i As Long Sheets(3).Select 最終行 = Range("A2").End(xlDown).Offset(1).Select 行 = ActiveCell.Row 列 = ActiveCell.Column myNO = TextBox2.Value 検索行 = Range("A2").End(xlDown).Select ※・・・Set 一致 = Range("A2:検索検").Findwhat:=TextBox2,lookat:=xlWhole) If 一致 Is Nothing Then MsgBox "データがありません。新規コード入力します。" Cells(行, 列 + 0) = UserForm1.TextBox2.Value Cells(行, 列 + 1) = UserForm1.ComboBox7.Value Else i = Cells(行 - 1, "A") Cells(i, 列 + 0) = UserForm1.TextBox2.Value Cells(i, 列 + 1) = UserForm1.ComboBox7.Value End If End Sub 「エラー1004'Range'メソッドは失敗しました'Global'オブジェクト」とでます。※印が黄色になっています。 ユーザーフォーム1のテキストボックスの値をシート3のA列から検索して、一致すれば、A列の一致セルに上書き入力して、一致が無い場合はA列の空白セルに追加入力したいのです。よろしくお願い致します。
- ベストアンサー
- その他（プログラミング・開発）
- vba検索結果を保持しつつ、次の検索結果が欲しい
a列にあるセルがe列にないか検索し、あった場合は、b列にあるセルがf列にないか検索し、あった場合は、c列にあるセルがg列にないか検索し、あった場合は、c列とg列が合致した2つ隣のセル(i列)に、d列にあるセルとh列にあるセルを結合させた結果を、表示させたいです。 以下のコードを走らせましたが、何も起こりませんてした。 お手数ですが、ご教示いただけますと幸いですm(_ _)m sub merge () dim i as long for i = 1 to cells(rows.count,1).end(xlup).row if cells(i,1) = cells(i,5) then if cells(i,2) = cells(i,6) then if cells(i,3) = cells(i,7) then cells(i,7).offset(0,2) = cells(i,4) and cecls(i,8) i = i + 1 end if end if end if next end sub
- ベストアンサー
- Excel（エクセル）
- Excel VBA リストボックスの複数列表示の方法について
すいません、エクセルVBAのユーザーフォームのリストボックスの表示方法について質問があります。 シートのセルに A列 D列 G列 1行 りんご 赤 120円 2行 みかん 黄 130円 3行 すいか 緑 110円 4行 りんご 赤 160円 . ・・・ ・ ・・・ . と、50行まで値を入れます。 VBAでユーザーフォームを挿入し、 Private Sub UserForm_Initialize() With ComboBox1 .AddItem "りんご" .AddItem "みかん" .AddItem "すいか" End With End Sub でコンボボックスの値を設定し、次に Private Sub ComboBox1_Change() Dim i As Integer For i = 1 To 50 If Cells(i, 1).Value = ComboBox1.Value Then With ListBox1 .ColumnCount = 3 .AddItem Cells(i, 1) End With End If Next i End Sub このときコンボボックスと同じ値の行について、 リストボックスにA列、D列、G列を表示させるにはどうしたらいいのでしょうか。 例えばコンボボックスで「りんご」を選択したときに、 リストボックスを りんご 赤 120円 りんご 赤 160円 と表示させたいのですが、 .AddItem Cells(i, 1) では一列だけしか表示できません。 Rowsorceを使ってみたりしましたが、どうにもうまく出来ませんでした。 よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- 他シートのある列を検索して一致したらセルに色をつける方法
次のような処理がしたいのですが、Excelの数式に詳しい方、ご教示お願いします。 次の3つのシートが一つのBOOKにあるとします。 ■Sheet1 1列目 AAAA BBBB CCCC ： ■Sheet2 1列目 BBBB : ■Sheet3 1列目 AAAA CCCC : Sheet1の一列目にあるデータについて、Sheet2あるいはSheet3の1列目を検索し一致するものがあれば、Sheet1の一列目の各セルに色をつけるという処理をしたいです。 できれば、Sheet2に一致した場合と、Sheet3に一致した場合とで、色を変えたいです。 よろしくお願いします。
- ベストアンサー
- 会計ソフト
- 比較したいセルの文字列が一致したら"一致"
いい案が思い浮かばないため皆さんのお知恵をお貸しください。 下はエクセルと思ってください A列 B列 1 2009/01/07/22:55 2009/01/07/22:56 2 テスト1 テスト1 3 テスト2 テスト2 4 テスト3 テスト3 5 テスト4 テスト6 とこのようなシートがあります。 セルA1とB1は時間のため可変で比較対照としたくありません それ以外のA列とB列がすべて一致したとき一致 不一致があればセルA5が不一致とmsgboxで出したいと考えております。 まだ思案中で途中なのですが Sub test() Dim i As Integer i = 1 Do While Cells(i, 1) <> "" If Cells(i, 1) = Cells(i, 2) Then MsgBox "一致" i = i + 1 ElseIf Cells(i, 1) <> Cells(i, 2) Then MsgBox "不一致" i = i + 1 End If Loop End Sub いまはまだこの程度のレベルです 宜しくお願いします。
- ベストアンサー
- オフィス系ソフト
- Excel VBAで文字列の部分一致の文字列を表示
以前、こちらで頭５文字までの一致で文字列を表示するVBAを教えて頂きました。今回はFINDなどの部分一致での文字列を表示することをしたいのですが、ご教示いただけますと幸いです。 下記はSheet1のA3に文字を5文字以内いれるとSheet２のC列からピックアップしてSheet１のA列に文字列を表示する及びSheet２のB列のデータをSheet１のC列に表示させるVBAです。 Sub Test2() Dim Ws1 As Worksheet, Ws2 As Worksheet Dim SData As String, i As Long, VRet As Variant Dim c As Range, LastRow As Long Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") SData = CStr(Ws1.Range("A3").Value) If SData = "" Then Exit Sub i = 5 LastRow = Ws1.Cells(Rows.Count, "A").End(xlUp).Row If LastRow < i Then LastRow = i End If Ws1.Range(Ws1.Cells(i, "A"), Ws1.Cells(LastRow, "C")).ClearContents With Ws2 For Each c In .Range(.Cells(1, "C"), .Cells(Rows.Count, "C").End(xlUp)) VRet = InStr(1, CStr(c.Value), SData, vbTextCompare) If VRet = 1 And Len(c.Value) >= 10 Then Ws1.Cells(i, "A").Resize(1, 2).Value = c.Resize(1, 2).Value 'とりあえずSheet2のB列のデータ(C列のデータに同期したデータ)をSheet1のC列に Ws1.Cells(i, "C").Value = .Cells(c.Row, "B").Value i = i + 1 End If Next End With End Sub 宜しくお願い致します。
- ベストアンサー
- Excel（エクセル）
- エクセル セルの文字列の有無からほかのセルに数値を
勤務リスト.xlsx におきまして セルE1に、午前休、 という文字列があれば セルF1に数値の0 セルG1に数値の2000 を入力 同様に セルEiに、午前休、 という文字列があれば セルFiに数値の0 セルGiに数値の2000 ３１日を計算にいれて iを1から30としました エクセルファイルの開発から マクロに行き 以下のコードをいれましたが ------------------------------- Sub 午前休み() Dim 選択シート As Sheets Dim i As Integer Set 選択シート = ActiveWindow.SelectedSheets If InStr(Cells(5, i), "午前休") > 0 Then Cells(6, i).Value = 0 Cells(7, i).Value = 2000 i = 1 Do Until i = 30 i = i + 1 Loop End If End Sub 上記 作動しません すみません 御教示くださいませ win10 office365
- ベストアンサー
- その他（プログラミング・開発）
- エクセルのマクロ（黄色付け）
派遣切り後、事務職の就職がようやく見つかりました。 仕事の効率を少しでも上げて、より多くの業務処理をしたいので下記のマクロを作成したいと考えています。 １ヶ月前に書籍を購入して独自でできるか試したのですがダイレクトな情報が見つからず、基礎の部分だけはできたところです。 恐縮なのですがもし、できる方がいましたらぜひ教えて頂けませんでしょうか【黄色付け機能の所を】。 赤色付け機能（既に有り）： 下記のようにSheet1のA列の数字を１つずつ検索して、sheet2にその数字があれば、sheet2のそのセル赤くする。 Sub 赤色付け() Set WS1 = Worksheets("Sheet1") Set WS2 = Worksheets("Sheet2") Dim RowPos As Integer Dim i As Integer For RowPos = 1 To 200 If WorksheetFunction.CountIf(Range(WS2.Cells(1, 1), WS2.Cells(200, 1)), WS1.Cells(RowPos, 1)) > 0 Then i = WorksheetFunction.Match(WS1.Cells(RowPos, 1), Range(WS2.Cells(1, 1), WS2.Cells(200, 1)), 0) WS2.Cells(i, 1).Interior.ColorIndex = 3 End If Next End Sub 【黄色付け機能：】 sheet1羅列を検索してsheet2に無い場合、逆にsheet1のその数字（検索してなかった数字）を黄色にもする ということは可能でしょうか。 下の場合、sheet1の123456と789123と456789が黄色になります。 そして、sheet2の123456と789123と456789以外が赤色になります。 ●sheet1のA列に下記のような数字が羅列(200行程)しています。 238062 238075 238096 238210 91518 238230 123456 789123 456789 ●sheet2のA列に下記のような数字が羅列しています。 91518 238062 238075 238096 238210 238230
- ベストアンサー
- その他MS Office製品
- 悩んでくれる方募集中！(コード掲載)
いままで4月という名のシートの「A列」のランダムな位置に数字の[ 1 ]を数カ所とびとびで入力して列を選択した場合、選択した列に入っている行データーを合計請求書シートにあてはめて印刷しておりました。（下記コード使用） 悩みですが、プリント（プレビューでも可）したという証に[ 1 ]を入力していたセルに[ 1 ]を消して紫の色を付けたいのですが可能でしょうか。 又、1月から12月までシートと印刷用合計請求書シートからなるブックなのですが、月ごとに下記のコードの月表示のみ変更してコピーして使用しているため、12コードある状態です。 もっとスマートなコードおしえていただけないでしょうか。 よろしくお願いいたします。 Sub 合計請求書印刷4月() Dim Sheet1 As Worksheet Dim Sheet2 As Worksheet Set Sheet1 = ThisWorkbook.Worksheets("4月") Set Sheet2 = ThisWorkbook.Worksheets("合計請求書") Dim baseRow As Long ' 7行目から、2列目(顧客名)が空になるまでループ baseRow = 7 i = baseRow j = 1 Do While (Sheet1.Cells(i, 2).Value <> "") If (Sheet1.Cells(i, 1).Value = 1) Then Select Case j Mod 3 Case 1 Sheet2.Range("W8").Value = Sheet1.Cells(i, 2).Value Sheet2.Range("B15").Value = Sheet1.Cells(i, 8).Value Sheet2.Range("W15").Value = Sheet1.Cells(i, 10).Value Sheet2.Range("G15").Value = Sheet1.Cells(i, 9).Value Case 2 Sheet2.Range("W25").Value = Sheet1.Cells(i, 2).Value Sheet2.Range("B32").Value = Sheet1.Cells(i, 8).Value Sheet2.Range("W32").Value = Sheet1.Cells(i, 10).Value Sheet2.Range("G32").Value = Sheet1.Cells(i, 9).Value Case 0 Sheet2.Range("W42").Value = Sheet1.Cells(i, 2).Value Sheet2.Range("B49").Value = Sheet1.Cells(i, 8).Value Sheet2.Range("W49").Value = Sheet1.Cells(i, 10).Value Sheet2.Range("G49").Value = Sheet1.Cells(i, 9).Value ' 印刷プレビュー Sheet2.PrintPreview Case Else End Select j = j + 1 End If i = i + 1 Loop If j Mod 3 = 1 Then End Set Sheet2 = Nothing Set Sheet1 = Nothing Else Sheet2.Range("W42").Value = "" Sheet2.Range("B49").Value = "" Sheet2.Range("W49").Value = "" Sheet2.Range("G49").Value = "" If j Mod 3 = 2 Then Sheet2.Range("W25").Value = "" Sheet2.Range("B32").Value = "" Sheet2.Range("W32").Value = "" Sheet2.Range("G32").Value = "" End If Sheet2.PrintPreview End If Set Sheet2 = Nothing Set Sheet1 = Nothing End Sub
- ベストアンサー
- Visual Basic
お礼
うまくいきました！