• ベストアンサー
  • 困ってます

エクセルVBAの修正をお願いいたします。

下記VBAをご教授受けて何とか作りましたが、一行指定で作成したのですが、その時によりデータ数にばらつきがありますので、現状データがあるセルだけを拾ってきてデータのあるなしを、JのセルとKのセルに2種類表示するように作成したつもりですが、データがないセルにも延々と Jのセルには 1040272 Kのセルには * が表示されますのでデータが現状ないセルには何も表示されないようにしたいと思います。 自分でいろいろ調べながらしてみるのですが埒が明かない状態になっておりますので、なにとぞお助け、ご教授をお願いいたします。 わかりにくい説明で申し訳ございませんがなにとぞよろしくお願いいたします。 Range("H2").Select ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-5],RC[-4])" Selection.AutoFill Destination:=Range("H2:H10000") Range("H2:H10000").Select Columns("H:H").Select Selection.Copy Columns("I:I").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Selection.Replace what:="-", Replacement:="", lookat:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Selection.Replace what:="_", Replacement:="", lookat:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Sheets("登録商品リスト").Select Columns("C:C").Select Application.CutCopyMode = False Selection.Copy Columns("E:E").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Selection.Replace what:="_", Replacement:="", lookat:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Selection.Replace what:="-", Replacement:="", lookat:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("F2").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "=UPPER(RC[-1])" Selection.AutoFill Destination:=Range("F2:F10000") Range("F:F").Select Columns("F:F").Select Selection.Copy Columns("G:G").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet2").Select Range("J2").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "=COUNTIFS(登録商品リスト!C[-3],C[-1])" Selection.AutoFill Destination:=Range("J2:J1500") Range("J:J").Select Dim i As Long, endRow As Long, str As String, c As Range, wS1 As Worksheet, wS2 As Worksheet Set wS1 = Worksheets("登録商品リスト") Set wS2 = Worksheets("Sheet2") endRow = wS2.Cells(Rows.Count, "K").End(xlUp).Row Application.ScreenUpdating = False If endRow > 1 Then Range(wS2.Cells(2, "K"), wS2.Cells(endRow, "K")).ClearContents End If For i = 2 To wS2.Cells(Rows.Count, "I").End(xlUp).Row str = Left(wS2.Cells(i, "I"), 5) Set c = wS1.Range("G:G").Find(what:=str, LookIn:=xlValues, lookat:=xlPart) If Not c Is Nothing Then wS2.Cells(i, "K") = "*" End If Next i Application.ScreenUpdating = True End Sub

共感・応援の気持ちを伝えよう!

  • 回答数2
  • 閲覧数279
  • ありがとう数2

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.2
  • tom04
  • ベストアンサー率49% (2537/5117)

No.1です。 補足を何度も読み返してみたのですが、 間違っていたらごめんなさい。 「登録商品リスト」Sheetも「Sheet2」も1列だけの操作でできそうな感じですので 勝手に↓のコードにしてみました。 「登録商品リスト」のC・D列を結合し、「-」と「_」を消して大文字にしたものをE列に表示! 「Sheet2」のC・D列を結合し、「登録商品リスト」と同様の操作の結果をH列に表示! 「登録商品リスト」のE列の中に「Sheet2」のH列と完全一致するものは J列に「1」を表示、K列にアスタリクス(*)を表示 「登録商品リスト」SheetのE列の中に「Sheet2」の「H列の頭5文字」と部分一致するものは J列に「2」を表示、K列にアスタリクス(*)を表示 上記どちらでもないものはJ列に「0」をK列は空白のまま! というやり方です。 Sub Sample1() 'この行から Dim i As Long, endRow1 As Long, endRow2 As Long, c As Range, r As Range, str As String Dim wS1 As Worksheet, wS2 As Worksheet Set wS1 = Worksheets("登録商品リスト") Set wS2 = Worksheets("Sheet2") endRow1 = wS1.Cells(Rows.Count, "C").End(xlUp).Row '←「登録商品リスト」SheetのC列最終行 If endRow1 > 1 Then Range(wS1.Cells(2, "E"), wS1.Cells(endRow1, "E")).ClearContents End If With Range(wS1.Cells(2, "E"), wS1.Cells(endRow1, "E")) '←「登録商品リスト」SheetのE列のみで処理 .Formula = "=UPPER(C2&D2)" .Value = .Value .Replace what:="-", replacement:="", lookat:=xlPart .Replace what:="_", replacement:="", lookat:=xlPart End With endRow2 = wS2.Cells(Rows.Count, "C").End(xlUp).Row '←「Sheet2」のC列最終行 If endRow2 > 1 Then Range(wS2.Cells(2, "H"), wS2.Cells(endRow2, "H")).ClearContents End If With Range(wS2.Cells(2, "H"), wS2.Cells(endRow2, "H")) '←「Sheet2」のH列のみで処理 .Formula = "=UPPER(C2&D2)" .Value = .Value .Replace what:="-", replacement:="", lookat:=xlPart .Replace what:="_", replacement:="", lookat:=xlPart End With For i = 2 To endRow2 With wS2.Cells(i, "J") str = Left(wS2.Cells(i, "H"), 5) '←「Sheet2」のH列頭5文字を格納 Set c = wS1.Range("E:E").Find(what:=wS2.Cells(i, "H"), LookIn:=xlValues, lookat:=xlWhole) Set r = wS1.Range("E:E").Find(what:=str, LookIn:=xlValues, lookat:=xlPart) If Not c Is Nothing Then '←「登録商品リスト」SheetのE列に完全一致するデータがあれば .Value = 1 '←J列に「1」を表示 .Offset(, 1) = "*" '←K列に「*」を表示 ElseIf Not r Is Nothing Then '「登録商品リスト」SheetのE列に部分一致(頭5文字)があれば .Value = 2 '←J列に「2」を表示 .Offset(, 1) = "*" '←K列に「*」を表示 Else .Value = 0 '←完全一致・部分一致どちらもなければ「0」を表示 End If End With Next i End Sub 'この行まで ※ 質問文のコードでは10000行までオートフィルしているようですが、 どちらのSheetもC列の最終行まで!というコトにしています。 的外れならごめんなさいね。m(_ _)m

共感・感謝の気持ちを伝えよう!

質問者からのお礼

tomo04さん 本当にありがとございます。 一つ一つ作業を確認しながらバラバラに作成したものを組み上げてましたので無駄が多い部分も作業を簡潔にしていただきありがとうございました。 完ぺきにできました。 また、説明を付けていただきましたのでとてもありがたく、今後の参考にもなります。 イロイロ便利にと考えておりますので、また、お世話になることもあろうかと思いますがその時はよろしくお願いいたします。  カープの来年の活躍を祈っています。 ドラフトでよい選手が取れますように祈っています。

関連するQ&A

  • Excelマクロ 置換について教えてください。

    A列の,10を,15に置換したいので下記マクロを記録しました。 ほかに,10を,16などにしたい場合もあるため、 入力画面を表示して初期値は,10から,15ですが、ほかを入力した場合は他の値で置換するマクロを教えてください。 Sub Macro1() Columns("A:A").Select Selection.Replace What:=",10", Replacement:=",15", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False End Sub

  • エクセルのマクロ 大量の置換の記述を簡略化

    Cells.Select Selection.Replace What:="東京", Replacement:="東京都", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False このような置換のマクロが何十個とあって 置換前の語句と置換後の語句ごとに すべて記述していますが 「置換の記述そのものはまったく同じなので  その中に語句を順番に入れ込んでいく」 という風な記述はできるものでしょうか? もし方法があるならば御教授願いたいです 宜しくお願い致します

  • VBAセル参照のパスのブック名に汎用性を持たせたい

    皆様どうぞ宜しくお願いいたします。マクロ初心者です。 Excel 2003で作業をしております。 今回の仕事で必要なので、大変困っております。 BOOK1とBOOK2を開き、BOOK1のAシートのセル参照をBOOK2でもBOOK2でのセル参照として活かす為、BOOK1のAシートの=をすべて#に置換した後、BOOK2にAシートをコピーし、逆に#を=に戻しました。 ここから後なのですが、BOOK名が特定されてしまうため、汎用性が効きません。 どのようにすればよいのかお教えください。 どうぞ宜しくお願いいたします。 下記マクロコード Cells.Replace What:="=", Replacement:="#", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False Sheets("店頭").Select Sheets("店頭").Copy Before:=Workbooks("ここの部分です.xls").Sheets(3) Cells.Replace What:="#", Replacement:="=", LookAt:=xlPart, SearchOrder _ :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False End Sub

その他の回答 (1)

  • 回答No.1
  • tom04
  • ベストアンサー率49% (2537/5117)

こんばんは! http://okwave.jp/qa/q8309495.html ↑のURLで最後の部分を回答した者です。 それまでのコードを拝見して、結局何をしたいのか見えてこないのですが・・・ コードではF・H列は10000行目まで数式をオートフィルしていて、 J列だけは1500行目までですね? そして >ActiveCell.FormulaR1C1 = "=COUNTIFS(登録商品リスト!C[-3],C[-1])" の「COUNTIFS関数」の使い方がおかしいように思えるのですが・・・ (検索範囲だけで「検索条件」が指定されていないとみれます) おそらくこの関数のおかげ?で意図しない結果が表示されているのでは? ※ コードを詳しく検証していませんので どのようなコトをやりたいのか!という部分が理解しかねますので (判る人が見れば判るのだとおもいますが、今は気力がありません。カープも早々と負けたことですし) この程度でごめんなさいね。m(_ _)m

共感・感謝の気持ちを伝えよう!

質問者からの補足

早々のアドバイスありがとうございます。 詳しく書かず、いきなりコードだけの質問で申し訳ないです。 今回作成したいと思っているものは、 Sheet1→登録商品リスト Sheet2→Sheet2 上記2枚のシートを使用してデータのチェックをしたいと思っています。 Sheet1の方には、最低限チェックするのに必要なデータが”A”~”D”まで入っていて ”E”のセルには”C”の列に入っている商品コードを”-”や”_”を抜いた形のコードが入力されるようにしています。 ”F”のセルには"E”の商品コードがすべて大文字になるように設定しています。 ”G”のセルには”F”のセルのデータの値が貼り付けられるようにしています。 上記がShhet1=登録商品リストの内容です。 また登録商品リストの方には日々商品が追加されていきます。 Sheet2には前日に動いた商品のデータを入力されているのですが、 ”A"~”G"までは前日に動いた商品の品番とかが入っています。 ”H"のセルには”C"のデータと”D"のデータを結合したものが入力されるように設定しています。 ”I"のセルには”H"のセルの値を入力が入力され、なおかつ”-””_”が除かれる設定をしています。 ”J"のセルには”登録商品リスト”の”G"のセルの内容と”I"のセルの内容の完全一致データに”1”、ないデータには”0”が入るようにチェックできるようにしました。 このままだと、チェック漏れする商品コードがありましたので、前回何とか解消すべくコードをお伺いいたしました。 前回お伺いしたコードの結果が”K"に反映されるようにしました。 あいまい検索と完全一致の両方の結果を合わせますとほぼ完ぺきに商品コードを拾うことができます。 私の力不足で本来なら現状あるデータだけの結果を”J""K"の列に表示させたいのですが、アルファベットの列の一行指定をしてしまうとコードにエラーが出るので1500、10000ととりあえず行数指定をしている次第です。 自分でもよくわからなくなってしまい質問致しました。 わかりづらく申し訳ないです。 育成のカープ、これから良い選手が続々育ち日本一になる日も近いと思います。

関連するQ&A

  • エクセルで指定した文字に自動で置換することは可能ですか??

    A1セルに「バナナ」と表示されると下のマクロの記録で作った”置換するマクロ”の「りんご」の部分を「バナナ」に変更し、さらにこの置換マクロを自動実行することはできますか?? Sub Macro1()' Cells.Select Selection.Replace What:="名前(1)", Replacement:="りんご", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Range("A1").Select End Sub このマクロの記録でなくてもいいんですが、あるセルに置換したい文字が表示された時点でシート内の置換が実行されるようにしたいんですけど・・・・・。 よろしくお願いします。

  • EXCEL 違う端末でマクロエラー

    私の端末で正常に作動したEXCELのマクロが、 他の端末ではエラーになり正常に動きません。 他の端末で実行する際、マクロやセルの中身など全く変更していません。 この場合、どのような原因が考えられますでしょうか? マクロは以下の部分でエラーが出ています。 Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False よろしくお願いします。

  • エクセル2003で、動作するでしょうか?

    現在、エクセル2007でマクロの作成練習をしていますが、 マクロの記録を使用して次のマクロを得ました。 > Columns("B:B").Select Selection.Replace What:="P", Replacement:="m" ,_ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False,_ SearchFormat:=False, ReplaceFormat:=False エクセル2003を使用している友人の依頼で作成したものですが、 当方、エクセル2003の環境がないため、動作するのか エラーが生じるのか分かりません。 どなたか教えて下さい。 エラーが出るなら、どの部分を直せばいいのかも。よろしくお願いします

  • excelのvbaを使って日付を置換したいのです

    こんにちは。いつも質問ばかりですみません。 今、excell の VBAの勉強をしているのですが、たとえば、B列に2004/5/3 とか、2004/5/5とか、5月の日付ばかりはいっていたとして、その2004/5の部分を2004/6に置換したいとします。 それを、マクロでやらせてみて、VBAを見ると Sub Macro9() Cells.Replace What:="2004/5", Replacement:="2004/6", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False End Sub のようになるのですが、このプロシージャーを実行しても、うまく置換できません。 どのように記述したら、できるのか、教えていただけるとうれしいです。 よろしくお願いいたします。

  • VBAで実行時エラー '1004'の解決方法

    VBA初心者です。 文字列を置換しようと思い、マクロを記録したところ下記ソースになりました。 Sub Macro1() Columns("D:D").Select Selection.Replace What:="エリア:", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False End Sub このマクロを単体で動かすと問題なく動作するのですが、他シートにおいてあるボタンに登録して一番最初に実行すると「実行時エラー '1004'」が出てしまいます。 ネットで色々調べましたが、解決方法が分かりません。 宜しくお願い致します。

  • エクセルでマクロを使用しての置換

    マクロ初心者です。 データを変換するシステムをマクロで作成していますが、 自分のPCではちゃんと実行できるのに、お客さんのPCで実行するとエラーが出てしまいます。 エラーが出る部分は、どうも置換するところらしく、 Selection.Replace What:="<BR>", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ここが黄色く表示されるそうです。 どこを直せばよいですか?

  • SearchFormatやReplaceForma

    エクセルでマクロの記録をしたら Sub Sample() Cells.Replace _ What:="a", _ Replacement:="b", _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ MatchCase:=False, _ SearchFormat:=False, _ ReplaceFormat:=False End Sub のように取得されて、一つ一つの引数を確認したいのですが、 http://www.moug.net/tech/exvba/0050117.html を見ても SearchFormatやReplaceFormatについての説明がないのですが これらについての説明を見るにはどうすればいいでしょうか? というか、なんでリンク先にはこれらの説明がないのですか? あまり使わないプロパティ?だからでしょうか?

  • マクロ範囲指定について(入力された行だけマクロを適用したい)

    マクロについて教えていただきたいことがあります。マクロを登録したボタンを押すと、名簿に名前が入力されている行だけに「○」をつけるよう作りたいと思っています。 名簿は45人分ですが、人数が部署によって30人だったり35人だったりするので、どの人数でも対応できるようなマクロの書き方を教えていただければと思います。 今できているのはこちらです。 Range("G11:AE55").Select Selection.Replace What:="", Replacement:="○", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False ActiveWindow.SmallScroll Down:=-45 Range("G11").Select これですと、名前が入力されていない部分まで○がついてしまい、困っています。 どうか、アドバイスをいただけますようお願いいたします。

  • Excel VBE 検索結果がない時の対処方法

    いつもお世話になっております。 Excelで簡単な文字当てゲーム的なものを作っています 文字列(100個程度)の中から、ある文字列を探し出して、そのセルの文字色を塗り替えるというマクロを組んでいます。 検索部分は下記のように記述してあります。 検索文字列がある時にはうまく動作しますが 検索文字列がない時にはエラーになります。 検索文字列がない時の対処方法を教えて下さい。 よろしくお願いします。 kaitou = Range("g2").Value Range("G2").Select Selection.Copy Columns("B:B").Select Selection.Find(What:=kaitou, After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate

  • EXCEL マクロでの検索をお教えください

     下記のようなマクロを使いたいのですがこの場合×があるときは良いのですが、  無いときエラーが出ます。どの様にすれば良いのかお教えください。  無いときエラーは オブジェクト変数または With ブロック変数が設定されていません。  となります。 Sub 検索()    Range("K12:K70").Select    Cells.Find(What:="×", After:=ActiveCell, LookIn:= _    xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _    xlNext, MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate End Sub