• 締切済み

Instr関数とLike演算子を組み合わせを教えて

Instr関数とLike演算子を組み合わせたものでループさせたい(VBA) Instr関数で複数のOr条件を満たすものを印刷と表示させ、Like演算子でワイルドカードであいまい検索で一致するものも印刷と表示させたいのですが上手くいきません。 本当はInstr関数とLike関数を組み合わせたいのですが調べても出てこず困っております。 どなたかお教えいただけないでしょうか? ちなみにVBA初心者です、、 Sub 印刷() Dim SHEETNAME As String Dim n As Long SHEETNAME = ActiveSheet.Name 'データ数の確認 S = Sheets(SHEETNAME).Range("c1000").End(xlUp).Row '(1)標準製品かつ第一産業かつ-の右側がJのもの と (2)標準製品かつ第二産業のもの のみ印刷(13列目は製品区分、10列目は会社名、4列目は型式名称) For n = 3 To S If InStr(Sheets(SHEETNAME).Cells(n, 13).Value, "標準製品") > 0 And Sheets(SHEETNAME).Cells(n, 10).Value = "第一産業" And _ Right(Left(Sheets(SHEETNAME).Cells(n, 4).Value, InStr(Sheets(SHEETNAME).Cells(n, 4).Value, "-") + 1), 1) = "J" Or _ InStr(Sheets(SHEETNAME).Cells(n, 13).Value, "標準製品") > 0 And InStr(Sheets(SHEETNAME).Cells(n, 10).Value, "第二産業") > 0 Then Sheets(SHEETNAME).Cells(n, 12) = "印刷" Else: Sheets(SHEETNAME).Cells(n, 12).Value = Delete End If Next '型式名称にOOPPが含まれるもののみ印刷(4列目は型式名称) For n = 3 To S Dim strValue As String Dim strPattern As String strValue = "Cells(n, 4).Value" strPattern = "*OOPP*" If strValue Like strPattern Then Sheets(SHEETNAME).Cells(n, 12) = "印刷" Else: Sheets(SHEETNAME).Cells(n, 12).Value = Delete Next End Sub

みんなの回答

  • kkkkkm
  • ベストアンサー率65% (1615/2454)
回答No.1

> strValue = "Cells(n, 4).Value" > strPattern = "*OOPP*" > > If strValue Like strPattern Then "Cells(n, 4).Value"という文字列にOOPPが含まれるかどうかの判断をしていますが strValue = Cells(n, 4).Value じゃないでしょうか。

関連するQ&A

  • Next,End Withのエラー

    Sub 入力() If Sheets("入力").Range("D3").Value = "" Then MsgBox "客先名を入力して下さい" Else Dim K最終行 As Long Dim T最終行 As Long Dim i As Integer With Sheets("入力") For i = 3 To 12 If .Cells(i, "H").Value <> "" Then U最終行 = Sheets("注文書").Range("G65536").End(xlUp).Row + 1 If U最終行 = 461 Then MsgBox "注文書がいっぱいです" Exit Sub Else End If E最終行 = Sheets("営業確認").Range("G65536").End(xlUp).Row + 1 Sheets("営業確認").Range("k" & E最終行).Value = .Cells(i, "b").Value Sheets("営業確認").Range("b" & E最終行).Value = .Cells(i, "c").Value Sheets("営業確認").Range("c" & E最終行).Value = .Cells(i, "d").Value Sheets("営業確認").Range("d" & E最終行).Value = .Cells(i, "e").Value Sheets("営業確認").Range("g" & E最終行).Value = .Cells(i, "h").Value Sheets("営業確認").Range("f" & E最終行).Value = .Cells(i, "i").Value Sheets("営業確認").Range("i" & E最終行).Value = .Cells(i, "m").Value Sheets("営業確認").Range("h" & E最終行).Value = .Cells(i, "p").Value Else End If Select Case .Cells(i, "o").Value Case "北" K最終行 = Sheets("北").Range("h65536").End(xlUp).Row + 1 Sheets("北").Range("B" & K最終行).Value = .Cells(3, "C").Value Sheets("北").Range("c" & K最終行).Value = .Cells(3, "b").Value Case "中" T最終行 = Sheets("中").Range("H65536").End(xlUp).Row + 1 Sheets("中").Range("b" & T最終行).Value = .Cells(3, "c").Value Sheets("中").Range("c" & T最終行).Value = .Cells(3, "b").Value End Select Exit Sub Dim Dummy As Worksheet Dim SheetName As String Dim OTA As Long Dim GEN As Long Dim SheetName2 As String With Sheets("入力") '3行目~22行目まで For j = 3 To 22 SheetName = Sheets("入力").Range("D3").Value On Error Resume Next Set Dummy = Sheets(SheetName) SheetName2 = .Cells(i, 14).Value 'もしシートがあれば・・・ If Err.Number = 0 Then 'SheetName2は入力シートのN行 SheetName2 = .Cells(i, 14).Value OTA = Sheets(SheetName2).Range("B65536").End(xlUp).Row + 1 Sheets(SheetName2).Range("A7").Value = .Cells(3, "D").Value Sheets(SheetName2).Range("C3").Value = .Cells(3, "C").Value Sheets(SheetName2).Range("B" & OTA).Value = .Cells(i, "H").Value Sheets(SheetName2).Range("I" & OTA).Value = .Cells(i, "I").Value Sheets(SheetName2).Range("F" & OTA).Value = .Cells(i, "K").Value Sheets(SheetName2).Range("H" & OTA).Value = .Cells(i, "L").Value Sheets(SheetName2).Range("J" & OTA).Value = .Cells(i, "M").Value 'シートが無ければ・・・ Else GEN = Sheets("原紙").Range("B65536").End(xlUp).Row + 1 Sheets("原紙").Range("A7").Value = .Cells(3, "D").Value Sheets("原紙").Range("C3").Value = .Cells(3, "C").Value Sheets("原紙").Range("B" & GEN).Value = .Cells(i, "H").Value Sheets("原紙").Range("I" & GEN).Value = .Cells(i, "I").Value Sheets("原紙").Range("F" & GEN).Value = .Cells(i, "K").Value Sheets("原紙").Range("H" & GEN).Value = .Cells(i, "L").Value Sheets("原紙").Range("J" & GEN).Value = .Cells(i, "M").Value '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName Next End With Exit Sub On Error GoTo 0 Sheets("原紙").Select Range("C3:E3,A7,B16:B35,F16:F35,H16:J35").Select Range("H35").Activate Selection.ClearContents Sheets("入力").Select Sheets("入力").Range("D3,G3:J12,L3:M12").Value = "" Sheets("入力").Range("D3").Select Range("B3").Formula = "=IF(D3="""","""",VLOOKUP(D3,'\\Seika-sv01\支店共有\マーケティング用\[担当者リスト.xls]リスト形式'!$B:$D,3,FALSE))" MsgBox "入力が完了しました" End If End Sub 上記のようにマクロを組みましたがエラーが出てしまいます。

  • Select Case について

    Sub dummy() Dim Dummy As Worksheet Dim SheetName As String Dim i As Integer Dim GEN As Long Dim OTA As Long With Sheets("入力") '3行目~22行目まで For i = 3 To 22 SheetName = Sheets("入力").Range("D3").Value On Error Resume Next Set Dummy = Sheets(SheetName) 'もしシートがあれば・・・ If Err.Number = 0 Then Select Case .Cells(i, 14).Value Case "TK-001" OTA = Sheets("TK-001").Range("B65536").End(xlUp).Row + 1 Sheets("TK-001").Range("B" & OTA).Value = .Cells(i, "H").Value Sheets("TK-001").Range("I" & OTA).Value = .Cells(i, "I").Value Sheets("TK-001").Range("F" & OTA).Value = .Cells(i, "K").Value Sheets("TK-001").Range("G" & OTA).Value = .Cells(i, "L").Value Sheets("TK-001").Range("J" & OTA).Value = .Cells(i, "M").Value End Select 'シートが無ければ・・・ Else '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName End If Next End With On Error GoTo 0 End Sub 上記の通りマクロを組みましたが、以下の事を行うのに悩んでいます。 (1)Select Case が100通りあるのですが、全てCaseを入れるのではなく  もっと簡単な方法はありますか?  ※『リスト』シートを作っており、B1~B100までcaseになるコードが入力されています。  例:   B    1  TK-001    2  TK-002    3  TK-003        ・        ・        ・   100   TK-100 というシートを作っています。 (2)今のマクロではどんな値でもシートがなければシートを作ってしまう状態ですが、  もし『リスト』シートの中に値があればシートを作る、無ければ作らないというマクロは可能ですか  

  • VBAの転記について

    With Sheets("入力") '3行目~22行目まで For i = 5 To 24 SheetName = Sheets("入力").Cells(i, "C").Value On Error Resume Next Set Dummy = Sheets(SheetName) SheetName2 = .Cells(i, "C").Value U最終行 = Sheets(SheetName2).Range("C65536").End(xlUp).Row + 1 If U最終行 = 39 Then Sheets(SheetName2).Copy BEFORE:=ActiveSheet Sheets(SheetName).Delete End If If Err.Number = 0 Then A = Sheets(SheetName2).Range("C65536").End(xlUp).Row + 1 Sheets(SheetName2).Range("C" & A).Value = .Cells(i, "G").Value Sheets(SheetName2).Range("D" & A).Value = .Cells(i, "I").Value Sheets(SheetName2).Range("E" & A).Value = .Cells(i, "L").Value Sheets(SheetName2).Range("F" & A).Value = .Cells(i, "N").Value Sheets(SheetName2).Range("G" & A).Value = .Cells(i, "P").Value Sheets(SheetName2).Range("H" & A).Value = .Cells(i, "R").Value Sheets(SheetName2).Range("I" & A).Value = .Cells(i, "T").Value Sheets(SheetName2).Range("K" & A).Value = .Cells(i, "V").Value Sheets(SheetName2).Range("L" & A).Value = .Cells(i, "X").Value ElseIf .Cells(i, "C").Value <> "" Then G = Sheets("原紙").Range("C65536").End(xlUp).Row + 1 Sheets("原紙").Range("B1").Value = .Cells(i, "D").Value Sheets("原紙").Range("B4").Value = .Cells(2, "D").Value Sheets("原紙").Range("C" & G).Value = .Cells(i, "G").Value Sheets("原紙").Range("D" & G).Value = .Cells(i, "I").Value Sheets("原紙").Range("E" & G).Value = .Cells(i, "L").Value Sheets("原紙").Range("F" & G).Value = .Cells(i, "N").Value Sheets("原紙").Range("G" & G).Value = .Cells(i, "P").Value Sheets("原紙").Range("H" & G).Value = .Cells(i, "R").Value Sheets("原紙").Range("I" & G).Value = .Cells(i, "T").Value Sheets("原紙").Range("K" & G).Value = .Cells(i, "V").Value Sheets("原紙").Range("L" & G).Value = .Cells(i, "X").Value '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName End If Next i End With On Error GoTo 0 上記のVBAを作成しましたが、 C行の値ごとの転記(G~Xの値)が出来ません。 どこが間違いか教えていただけないでしょうか。

  • 連続印刷について

    顧客名簿を作成し連続印刷により、市販されているようなアドレス帳の レイアウトで印刷したいのですが、以下の様に13人分の印刷をすると 次の連続印刷では1つ繰り上がって、印刷されるだけとなってしまいました。 次ページの印刷からは、14行めから更にその次では28行目からと 印刷設定をしたいのですが、どうすれば宜しいのでしょうか? 別シートに印刷用のレイアウトをVLOOKUPで作成し、更に別シートで印刷設定を行っています。 初心者なりに見よう見まねで作ってみたのですが・・・・ 説明が下手で分かりにくく申し訳ありません。 護教授宜しくお願い致します。 Sub 連続印刷1() ' Dim mycounter As Integer Dim sita1 As Integer Dim migi1 As Integer mycounter = 1 sita1 = Sheets("設定").Cells(4, 2) migi1 = Sheets("設定").Cells(5, 2) For mycounter = 1 To 5 Sheets("顧客名簿").Select Range("O2").Value = Sheets("住所録").Cells(mycounter + 1, 1) Range("O6").Value = Sheets("住所録").Cells(mycounter + 2, 1) Range("O10").Value = Sheets("住所録").Cells(mycounter + 3, 1) Range("O14").Value = Sheets("住所録").Cells(mycounter + 4, 1) Range("O18").Value = Sheets("住所録").Cells(mycounter + 5, 1) Range("O22").Value = Sheets("住所録").Cells(mycounter + 6, 1) Range("O26").Value = Sheets("住所録").Cells(mycounter + 7, 1) Range("O30").Value = Sheets("住所録").Cells(mycounter + 8, 1) Range("O34").Value = Sheets("住所録").Cells(mycounter + 9, 1) Range("O38").Value = Sheets("住所録").Cells(mycounter + 10, 1) Range("O42").Value = Sheets("住所録").Cells(mycounter + 11, 1) Range("O46").Value = Sheets("住所録").Cells(mycounter + 12, 1) Range("O50").Value = Sheets("住所録").Cells(mycounter + 13, 1) Range(Cells(1, 1), Cells(sita1, migi1)).Select Selection.PrintOut Copies:=Sheets("設定").Cells(6, 2) Next ' End Sub

  • [VBA] InStrRevとLikeの組合せ

    こちらの識者の方々にはいつもお世話になっています。 VBAの質問です。 環境は下記になります。 OS=windowsXP SP3 Office=Excel2003(11.8347.8403) SP3 先日、 http://okwave.jp/qa/q8321600.html で質問した内容なのですが、解決したと思ったらまだ未解決のため、再度質問いたします。 A列に住所のデータがあるのですが、形式がちょっと特殊で、 A1 千代田区千代田1-1-1-301千代田マンション1号棟 A2 千代田区千代田2-3-4 というな形になっています。(A1,A2はセル番地表示で、その文字列がセルにあるわけではありません) 並び順が、市名(区名)・町名・丁目・番地・号地・部屋番号・物件名となっています。 データの定義は、丁目・番地・号地・部屋番号については半角数字・市名(区名)・町名・物件名は数字やアルファベットを含むものであっても全角であることは担保されております。 戸建てであればいいのですが、集合住宅の場合、物件名と部屋番号が入れ替わってしまっています。 これを、できればA列には住所、B列には物件名・(全角スペース)・部屋番号とわけたいのです。   A           B 1 千代田区千代田1-1-1  千代田マンション1号棟 301 2 千代田区千代田2-3-4 という内容で、ご回答いただいた Sub SplitAddresses()   Dim i As Long, n As Integer, pos1 As Integer, pos2 As Integer, pos3 As Integer   For i = 1 To Cells(Rows.Count, "a").End(xlUp).Row     With Cells(i, "a")       For n = 0 To 9         pos1 = InStrRev(.Value, n)         If pos2 < pos1 Then pos2 = pos1       Next n       Cells(i, "b").Value = Right$(.Value, Len(.Value) - pos2)       .Value = Left$(.Value, pos2)       pos2 = 0       pos3 = InStrRev(.Value, "-")       If pos3 And Cells(i, "b").Value <> "" Then         Cells(i, "b").Value = Cells(i, "b").Value & " " & Right$(.Value, Len(.Value) - pos3)         .Value = Left$(.Value, pos3 - 1)       End If     End With   Next i   Columns("a:b").AutoFit End Sub というコードでうまくいくと思ったのですが、 千代田区千代田1-2-3-4F千代田マンション1号棟 千代田区千代田1-1-1-A千代田マンション1号棟 といったデータも存在し、For n = 0 To 9ではまかなえないことがわかりました。 (数字の部屋番号だけではなく、4FやAなど、アルファベットの部屋番号が存在するということです) 数字だけではなく、半角英数字を末尾から検査し、その文字列がある位置を割り出す必要があるのですが、InStrRev関数とLike演算子を組み合わせて、返り値をpos1に代入しようと思ったもののうまくいきません。 ひとまず、返り値の確認のため、下記のようなコードを書きましたが、 Cells(1, 2) = InStrRev(Cells(1, 1), Like "*[0-z]*") というコードは通らず、 Cells(1, 2) = InStrRev(Cells(1, 1), Cells(1, 1) Like "*[0-z]*") というコードは返り値が0になってしまいます。 上記のような場合、どのようなコードが適していますでしょうか。 質問に不備不足等ございましたらご指摘ください。 ご面倒お掛けしますがよろしくお願いします。

  • Match関数がうまく機能していない??

    すみません。また教えて下さい。 過去ログを見てシート1にあったデータをシート4にあるデータと照らし合わせてすでにあれば書き換え、なければ追加というようにできるようにしたく過去ログを参考にしてやったのですが、どうしてもエラーが出てしまいます。 Private Sub aa() Dim intlastrow1 As Integer Dim strb As String Dim longlastrow1 As Long intlastrow1 = Sheets(1).Range("A7").End(xlDown).Row longlastrow1 = Sheets(4).Range("A1").End(xlDown).Row Dim c As Object Dim rtn As Variant Dim d As Integer With Sheets(4) .Select For Each c In .Range("A1", "A" & longlastrow1) rtn = Application.Match(c.Value, Sheets(1).Range("A7:A" & intlastrow1), 0) d = c.Row strb = Cells(d, "A").Value If IsError(rtn) Then With Sheets(4).Cells(longlastrow1 + 1, "A") .Value = strb With .Font .Name = "MS Pゴシック" .Bold = False .Size = 8 End With End With Sheets(4).Cells(longlastrow1 + 1, "B").Value = Sheets(1).Range("A2").Value Sheets(4).Cells(longlastrow1 + 1, "F").Value = ShowFormula(Sheet1.Range(Cells(d, "J"), Cells(d, "N"))) longlastrow1 = longlastrow1 + 1 End If If Not IsError(rtn) Then Exit Sub End If Next c End With End Sub 以上のように組んだのですがうまくいきません。 具体的に言うとシート1のA7よりしたに名前が並んでいる(山田、鈴木・・・)とお考え下さい(シート4のA2以下にも同様に名前が並んでいる)。字数の関係で判定後の処理が不十分になっています。

  • 顧客番号を指定して印刷するには?

    別シートに印刷用のレイアウトを作成し、更に別シートで印刷設定を行っています。 その印刷設定のページには、印刷開始顧客番号 印刷終了顧客番号とセルを作り、そこで顧客番号を指定して連続印刷したいのですが、今の状況だと、For MyCounter 1 to 5の5の部分を変え残りは手動で入力という方法で印刷しています。 顧客番号のみで連続印刷する為にはどうすれば宜しいのでしょうか? 宜しくお願いいたします。 ---------------------------------------------------------------- Sub 連続印刷2() Dim mycounter As Integer Dim sita1 As Integer Dim migi1 As Integer mycounter = 1 sita1 = Sheets("設定2").Cells(4, 2) migi1 = Sheets("設定2").Cells(5, 2) For mycounter = 1 To 5 Sheets("レイアウト2").Select Range("O2").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 2, 1) Range("O6").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 3, 1) Range("O10").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 4, 1) Range("O14").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 5, 1) Range("O18").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 6, 1) Range("O22").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 7, 1) Range("O26").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 8, 1) Range("O30").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 9, 1) Range("O34").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 10, 1) Range("O38").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 11, 1) Range("O42").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 12, 1) Range("O46").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 13, 1) Range("O50").Value = Sheets("住所録(会社)").Cells((mycounter - 1) * 13 + 14, 1) Range(Cells(1, 1), Cells(sita1, migi1)).Select Selection.PrintOut Copies:=Sheets("設定2").Cells(6, 2) Next End Sub

  • エクセル2000マクロ、チームの合計を別のシートに

    グラウンドゴルフで、1チーム5名、50チームで全員が2ラウンドのゲームのチーム別成績順位表を作ろうとしています。 ”2ラウンド集計”のワークシートに団体戦の個人成績表がありますので、これを元に、”チーム別”ワークシートに各チームだけの成績を抜き出して表示したくて、次のマクロをした結果、添付した画像のようになります。 解決方法を教えていただきたくよろしくお願いいたします。 Sub チーム成績順() ' ' チーム成績順 Macro ' マクロ記録日 : 2013/8/16 ユーザー名 : HAYAO MAEBARA ' 'Dim n Sheets("チーム別").Activate For n = 1 To 50 Cells(n + 4, 2).Value = Sheets("2ラウンド集計").Cells(n * 5 + 5, 2).Value Cells(n + 4, 3).Value = Sheets("2ラウンド集計").Cells(n * 5 + 5, 3).Value Cells(n + 4, 4).Value = Sheets("2ラウンド集計").Cells(n * 5 + 5, 4).Value Cells(n + 4, 6).Value = Sheets("2ラウンド集計").Cells(n * 5 + 5, 6).Value Cells(n + 4, 7).Value = Sheets("2ラウンド集計").Cells(n * 5 + 5, 7).Value Cells(n + 4, 8).Value = Sheets("2ラウンド集計").Cells(n + 9, 8).Value + Cells(n + 10, 8).Value + Cells(n + 11, 8).Value + Cells(n + 12, 8).Value + Cells(n + 13, 8).Value Cells(n + 4, 9).Value = Sheets("2ラウンド集計").Cells(n + 9, 9).Value + Cells(n + 10, 9).Value + Cells(n + 11, 9).Value + Cells(n + 12, 9).Value + Cells(n + 13, 9).Value Cells(n + 4, 10).Value = Sheets("2ラウンド集計").Cells(n + 9, 10).Value + Cells(n + 10, 10).Value + Cells(n + 11, 10).Value + Cells(n + 12, 10).Value + Cells(n + 13, 10).Value Cells(n + 4, 11).Value = Sheets("2ラウンド集計").Cells(n + 9, 11).Value + Cells(n + 10, 11).Value + Cells(n + 11, 11).Value + Cells(n + 12, 11).Value + Cells(n + 13, 11).Value Cells(n + 4, 12).Value = Sheets("2ラウンド集計").Cells(n + 9, 12).Value + Cells(n + 10, 12).Value + Cells(n + 11, 12).Value + Cells(n + 12, 12).Value + Cells(n + 13, 12).Value Cells(n + 4, 13).Value = Sheets("2ラウンド集計").Cells(n + 9, 13).Value + Cells(n + 10, 13).Value + Cells(n + 11, 13).Value + Cells(n + 12, 13).Value + Cells(n + 13, 13).Value Cells(n + 4, 14).Value = Sheets("2ラウンド集計").Cells(n + 9, 14).Value + Cells(n + 10, 14).Value + Cells(n + 11, 14).Value + Cells(n + 12, 14).Value + Cells(n + 13, 14).Value Cells(n + 4, 15).Value = Sheets("2ラウンド集計").Cells(n + 9, 15).Value + Cells(n + 10, 15).Value + Cells(n + 11, 15).Value + Cells(n + 12, 15).Value + Cells(n + 13, 15).Value Cells(n + 4, 16).Value = Cells(n + 4, 8).Value + Cells(n + 4, 12).Value Cells(n + 4, 17).Value = Cells(n + 4, 9).Value + Cells(n + 4, 13).Value Cells(n + 4, 18).Value = Cells(n + 4, 10).Value + Cells(n + 4, 14).Value Cells(n + 4, 19).Value = Cells(n + 4, 11).Value + Cells(n + 4, 15).Value Cells(n + 4, 20).Value = Cells(n + 4, 16).Value * (-3) Cells(n + 4, 21).Value = Cells(n + 4, 19).Value + Cells(n + 9, 20).Value Cells(n + 4, 22).Value = Cells(n + 4, 21).Value / 2 Next n End Sub

  • If Like Then条件式可変の場合の処理

    VBAにてSheet1の指定された番地にあるセルの値がSheet2のセル範囲にない場合はセルに色をつけると言うマクロを組んでいます。 Sub test() Dim i,z As Integer Dim WS As Worksheet Dim LastRow As Integer Dim Word1,Word2,Word3 As String Set WS = Worksheets("Sheet1") Word1 = WS.Cells(1,16).Value Word2 = WS.Cells(1,17).Value Word3 = WS.Cells(1,18).Value with Worksheets("Sheet2") LastRow = .Range("A" & Rows.Count).End(xlUp).Row For i = 3 To LastRow For z = 6 To 9 If .Cells(i,z).Value Like "*" & Word1 & "*" Or _ .Cells(i,z).Value Like "*" & Word2 & "*" Or _ .Cells(i,z).Value Like "*" & Word3 & "*" Then Else .Cells(i,z).Interior.ColorIndex = 6 End If Next Next End Sub 上記のマクロで変数Word1,2,3が1つだけの場合もあれば Word10まである場合も有り式を変更する必要が有ります。。 この場合、If Like 変数 Or の部分をフレキシブルに対応させる為にはどの様な式を書けば良いでしょうか(ToT)? 申し訳ありませんがご教授下さい(ToT) 宜しくお願い致します。

  • ユーザー関数ではフィルはダメ!?

    VBAを勉強し始めたばかりの初心者です。 自分でユーザー関数を組んでみたのですが、とても困っています。 =GetA("カナ氏名",1) のように、引数が二つあるユーザー関数を作ったのですが、フィルでコピーしたときに、二番目の数字が1,2,3,4と変わっていきません。 ユーザー関数は、フィルでコピーしたときに自動的に増えないのでしょうか?ちなみに、中身は以下のとおりです。 Function GetA(DataName As String, Yline As Integer) As String Dim Obj As Object Dim SheetName As String SheetName = "ExpData" Set Obj = Worksheets(SheetName).Cells.Find(DataName) If Obj Is Nothing Then GetA = "" Else Xline = Worksheets(SheetName).Cells.Find(DataName).Column GetA = Worksheets(SheetName).Cells(Yline, Xline) End If End Function

専門家に質問してみよう