• ベストアンサー
  • すぐに回答を!

エクセルのマクロで検索

教えてください。 エクセルにいろいろなセルに文字列が並んでいます。 フォームを作成し、テキストに文字列1、文字列2を指定します。 そこからある文字列1を検索し、もし見つかればその見つかった文字列1の右のセルに指定した文字列2を挿入したいのです。右のセルに文字列3がすでにある場合はその文字列3の下のセルに文字列2を挿入します。 もしみつからなければ、Aの一番下のセルに文字列2を挿入します。 といったプログラムをコーディングしたいのですが、マクロに関しては初心者です。VBは少しなら分かります。 できれば分かりやすく教えて頂けないでしょうか。 よろしくお願いします。

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

  • 回答数7
  • 閲覧数285
  • ありがとう数3

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

  • ベストアンサー
  • 回答No.6

とりあえず、No.5で書いた内容に基づいてVBAマクロを作ってみました。これを参考にしてみてください。 (補足を待たずに早とちりで作ってしまいました。ごめんなさい。) ただし、このNo.5で記述した内容では不備があります。 [会員組織図]ワークシートに "A","A1","A12" "B","B1" "_","B2","B21" ※"_"は空欄 と登録している状態で、Aさんが紹介者となる新会員"A2"さんを登録する場合、B2さんの下のセルに登録するのでしょうか? (私が何か勘違いしてたらごめんなさい。) 【内容】 フォームクラスをUserForm1とする。 下記VBAマクロを標準モジュールに追加する。 "会員登録"マクロを起動すると、会員登録フォームが表示される。 UserForm1クラスで、登録したいときにisEntryNewMenber()をコールする。 この関数の戻り値が trueであれば登録成功。 falseであれば登録失敗。 =========================== Private ws As Worksheet Public Sub 会員登録() Dim frm As UserForm1 Set frm = New UserForm1 Load frm frm.Show End Sub Public Function isEntryNewMenber(strNewMenber As String, strIntroductor As String) As Boolean Dim rIntroCell As Range Dim iRow, iCol As Integer isEntryNewMenber = False Set ws = Worksheets("会員組織図") strNewMenber = Trim(strNewMenber) strIntroductor = Trim(strIntroductor) If Len(strIntroductor) <> 0 Then '紹介者あり? Set rIntroCell = findMenber(strIntroductor) '紹介者検索 If Not rIntroCell Is Nothing Then '紹介者発見? Call entryNewMenber1(rIntroCell, strNewMenber) '紹介者の隣に登録 isEntryNewMenber = True Else '紹介者の名前なし 'エラーメッセージ表示 End If Else '紹介者なし Call entryNewMenber2(strNewMenber) '会員登録 isEntryNewMenber = True End If End Function '紹介者の名前検索 Private Function findMenber(ByVal strName As String) As Range Set findMenber = ws.Cells.Find(what:=strName) '氏名検索 End Function '新会員登録(紹介者あり) Private Sub entryNewMenber1(ByVal rIntroCell As Range, ByVal strName As String) Dim iRow, iCol As Integer iRow = rIntroCell.Row iCol = rIntroCell.Column + 1 While Len(Trim(ws.Cells(iRow, iCol))) <> 0 iRow = iRow + 1 Wend ws.Cells(iRow, iCol) = strName End Sub '新会員登録(紹介者なし) Private Sub entryNewMenber2(strName As String) Dim iRow, iCol As Integer Dim rEntryCell As Range Dim strR As String Dim i As Integer iRow = 0 Do strR = "IV" & CStr(iRow + 1) Set rEntryCell = Range(strR).End(xlToLeft) iRow = iRow + 1 iCol = rEntryCell.Column Loop Until (iCol = 1) And (Len(Trim(ws.Cells(iRow, iCol))) = 0) ws.Cells(iRow, iCol) = strName End Sub

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

質問者からの補足

Aさんが紹介者となる新会員"A2"さんを登録する場合、A1さんの下に挿入したいと思っております。 "A","A1","A12" "_","A2" "B","B1" "_","B2","B21" ※"_"は空欄 よろしくお願いします。

その他の回答 (6)

  • 回答No.7

> Aさんが紹介者となる新会員"A2"さんを登録する場合、A1さんの下に挿入したいと思っております。 > "A","A1","A12" > "_","A2" > "B","B1" > "_","B2","B21" ※"_"は空欄 その場合は、No.4で記述した仕様(2)を以下のように変更すれば大丈夫です。 (1)[Text1]に入力がある場合は、[会員組織図]ワークシートに該当する氏名があるか検索。 (2)見つかった場合、その右隣のセルに[Text2]の氏名を挿入。 までは同じです。(2)の仕様の後半を以下のように修正すれば対応できますよ。 右隣のセルが既に挿入済みの場合は、その1つ下のセルに氏名が挿入されているかチェックする。 A)挿入されている場合はその左隣(紹介者の列)のセルをチェックする。 AA)紹介者以外の氏名(未入力・空白を除く)だった場合は、その行を1行下方向にずらして(1行挿入して)その行に新会員の氏名を挿入する。 AB)紹介者の氏名または未入力(空白)だった場合は、引き続き1つ下のセルをチェックする。 B)挿入されてない場合は引き続き1つ下のセルをチェックする。 (かなりややこしい文章になってしまいました。多分もっとシンプルな文章になるかも・・・。) 次に、この仕様に基づいて新会員登録(紹介者あり)の関数を変更してみます。 '新会員登録(紹介者あり) Private Sub entryNewMenber1(ByVal rIntroCell As Range, ByVal strName As String) Dim iRow, iCol As Integer Dim strIntroName As String strIntroName = rIntroCell.Text iRow = rIntroCell.Row iCol = rIntroCell.Column + 1 Do While Len(Trim(ws.Cells(iRow, iCol))) <> 0 If Len(Trim(ws.Cells(iRow, iCol - 1))) <> 0 Then '紹介者の列に氏名あり? If StrComp(strIntroName, ws.Cells(iRow, iCol - 1)) <> 0 Then '紹介者の氏名でない? ws.Rows(iRow).Insert Shift:=xlDown '1行挿入 Exit Do 'チェック終了 End If End If iRow = iRow + 1 Loop ws.Cells(iRow, iCol) = strName End Sub ということで、上記関数を差し替えて実行すればお望みの結果になると思いますが、どうでしょう?

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

質問者からのお礼

Musaffahさん 何度も回答ありがとうございました。 大変助かりました。 また何かありましたら、ご協力お願いいたします。 感謝します。

  • 回答No.5

私も横から失礼します。 まずは、vivatomさんが作ろうとしているものの内容を整理したいと思います。 ・[会員組織図]ワークシートを用意する。 ・何かを起動して、フォームを表示する。 ・フォームの[Text1]には紹介者の氏名を入力。 ・フォームの[Text2]には新会員者の氏名を入力。 ・紹介者のない会員は[Text1]には何も入力しない。 ・フォーム内の[登録]ボタンをクリック後、入力チェック等を実施し、結果良好であれば[会員組織図]ワークシートに[Text2]の氏名を登録する。(て感じですよね?) ・最初の会員はA1セルに挿入。 ・同姓同名の人が複数いた場合の処理についてはとりあえず考慮しない。(今のところ検索条件が"氏名"のみしかわからないため。) という内容で、以下のルールで挿入する。 (1)[Text1]に入力がある場合は、[会員組織図]ワークシートに該当する氏名があるか検索。 (2)見つかった場合、その右隣のセルに[Text2]の氏名を挿入。右隣のセルが既に挿入済みの場合は、氏名が挿入されていないセルを下方向に探し、そこに挿入する。 (3)見つからない(紹介者のない会員の)場合は、[会員組織図]ワークシート内のもっとも下の行にある氏名の列によって、以下のように挿入する。 A)A1セルに何も入力されていない場合(会員第1号の場合)は、A1セルに挿入する。 B)A列の場合は、その下のセルに挿入。 C)A列以外の場合は、その下の行のA列に挿入。 これであってます??

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

質問者からの補足

その通りです。 紹介者の右隣に挿入する場合で、すでに挿入済の場合、その下のセルに挿入したいのですが、その下のセルが他の紹介者の会員が挿入されている場合があると思います。その場合はどうすればいいのでしょうか。 空欄で見分けるようにはできると思うのですが、セルが詰まっている場合はどうすればいいか分かりません。ですので、紹介者のセルの1つ右、1つ下のセルに挿入していこうかと考えています。どうでしょうか。 分かりい説明で申し訳ありません。 よろしくお願いします。

  • 回答No.4

横からお邪魔します。 CurrentRegionよりも、 UsedRangeの方が良いですよ。 A2,B1,B3が空っぽだったら他にも入ってても求めるセルがA2になってしまいますから。 UsedRangeならセルが飛んでても使用されてるセルの最小領域が取って来れます。 例えばC3とF5の2つのセルに値入ってたとしたら、 Range("C3:F5")がUsedRangeという事に。 なので、 maruru01さんのご説明の >Range("A1").CurrentRegion.Rows.Count を シート.UsedRange.Rows.Count に置き換えればいいと思います。 ただ、UsedRangeの領域の一番上が何行目かが分からないんですよね・・。 確実に1行目に何か入ってる事が保障されてるなら、 求めてるセルは Cells(シート.UsedRange.Rows.Count + 1, 1) でOKです。 が、1行目に何も入ってないとおかしな事になります。 予めダミーでA1に何か入れて、セルを求め終わったら消去するとか? うーん。もう1工夫お願いします・・。

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

  • 回答No.3
  • maruru01
  • ベストアンサー率51% (1179/2272)

再びNo.1です。 >シートの入力のあるセルの1番下の列(Aであるとは限らない) それなら、CurrentRegionプロパティでしょうか。 CurrentRegionはアクティブセル領域を選択するプロパティです。 (アクティブセル領域についてはヘルプを参照。) A1を含むアクティブセル領域は、 Range("A1").CurrentRegion になり、 Range("A1").CurrentRegion.Rows.Count で、この範囲の行数を取得出来ます。 したがって、範囲の先頭が1行目なので、 Cells(Range("A1").CurrentRegion.Rows.Count, 1) でデータ最下行のA列のセルを、 Cells(Range("A1").CurrentRegion.Rows.Count + 1, 1) でデータ最下行のすぐ下のA列のセルを参照することになります。 ただし、途中にまったく入力がない行があると、正しいアクティブセル領域を取得することは出来ません。 (どこか1項目にでもデータが入っていればOK。) このような場合がある場合は、仕方がないので、範囲の全列に対して、 Endプロパティで最下行を求めて、それらの最大値を最下行とするくらいですね。

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

  • 回答No.2
  • maruru01
  • ベストアンサー率51% (1179/2272)

No.1です。 >A11とは指定せずにAの一番下の文字列が挿入されている >セルの下に挿入したい Endプロパティで、終端セルを取得出来ます。 A列の最下行のセルは、 Range("A65536").End(xlUp) になります。 これは、A65536(A列の一番下)を選択しておいて、[Ctrl]を押しながら[↑]を押すのと同じようなことだと思って下さい。 「A1:A10」も可変にするなら、 Range("A1:A10") ↓ Range("A1", Range("A65536").End(xlUp)) に置き換えましょう。 そしてない場合も、 Range("A11") ↓ Range("A65536").End(xlUp).Offset(1) と置き換えます。

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

質問者からの補足

maruru01さん 何度もありがとうございます。 何度も質問ばかりですみません。 シートの入力のあるセルの1番下の列(Aであるとは限らない)の下の行のAの位置に文字列を挿入したいのです。 組織図を作成したいと考えております。 会員を挿入していくのですが、紹介者の右セルに会員を挿入って感じなんです。 で、紹介者のいない会員はA列の一番下のセルに挿入するのですが、A以外の列がAよりも下まで挿入されている場合はその下の行のA列に挿入したいのです。 分かりにくくて申し訳ありません。 お分かりになりましたら、教えて頂けないでしょうか。

  • 回答No.1
  • maruru01
  • ベストアンサー率51% (1179/2272)

こんにちは。maruru01です。 Findメソッドを使用すればいいと思います。 Dim myRange As Range Set myRange = Range("A1:A10").Find(What:=Text1.Text, Lookat:=xlWhole) If myRange Is Nothing Then   '見つからなかった場合   Range("A11").Value = Text2.Text Else   '見つかった場合   If myRange.Offset(, 1).Value = "文字列3" Then     '右隣りが"文字列3"の場合     myRange.Offset(1, 1).Value = Text2.Text   Else     '右隣りが"文字列3"でない場合     myRange.Offset(, 1).Value = Text2.Text   End If End If こんな感じ Findメソッドについての詳細は、VBAのヘルプを参照して下さい。

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

質問者からの補足

お返事ありがとうございます。 見つからなかった場合なんですが、A11とは指定せずにAの一番下の文字列が挿入されているセルの下に挿入したいのですが、どうすればいいのでしょうか。 ちょっと説明がうまくできていないと思いますが、教えて頂けないでしょうか。

関連するQ&A

  • Excel 検索・置換マクロ

    検索する文字列は、AH4のセルにかいている数値とし 置換後の文字列を“無し”にしたいです。 これを実行するマクロを教えてください。 何卒よろしくお願いしますm--m Excel2003

  • エクセルのマクロで特定の文字列を選択したい

    集計表にピボットテーブルを2つ入れるマクロを作成しています。 その際に、出来あがったピボットテーブルの項目ごとの合計を 表示しないためには、対象となるセルを選択して(Select) 表示しないを選択する(Selection.Delete)ことはマクロの記録からわかりました。 しかし、ピボットテーブルの枠が固定されているわけではないので、 合計欄の選択がうまくできません。 結果的には、A列の何行目かに「B在庫」という文字列が表示されていて、 その下からピボットテーブルが作成されています。 その「B在庫」の文字列から「右に3、下に2」と「右に1、下に5」 進んだセルをそれぞれ指定して(Select)削除(Selection.Delete)したいと思っています。 どのように「B在庫」と入力された文字列を探し出すのか、 また、そこから「右に3、下に2」と「右に1、下に5」進んだセルを 指定する方法を教えていただけないでしょうか。

  • Excel 2003のマクロについて

    セルにある文字列に”-”を加え、別のセルに移したいです。 例/ABCDEFGHIJ→ABC-DEFGH-IJ としたいです。 文字列の“-”の入る位置は、「例/」の位置で固定です。 Excel2003を使用しています。 マクロ等で一発変換できる方法はありますか? マクロ初心者なので、教えて下さい。宜しくお願い致します。

  • EXCELのマクロでテキストを読み込む方法

    EXCELのマクロを使って、テキストファイルから、ある文字列を検索し、コピーしEXCELのシートのセルにペーストするマクロの書き方をご存知の方は、ご教示願います。 例えば、テキストファイル中の「dog」という文字列を検索して、EXCELの決まったセル(A、1)にコピペするというマクロです。 よろしくお願い申し上げます。

  • エクセルの検索マクロについて

    今までオートフォーマットで検索していたのですが,一つの列に存在するデータが多量になったため,マクロを使った検索としたいです。 検索の方法として,「コンボボックス」で選択したデータを検索したいと考えています。 現状は以下の通りです。 ○検索元となるデータは,1つのSheetにまとめてあります。 ○「コンボボックス」で指定したいデータは4つあります。 ○検索元のSheetの,D列が文字列,E列が数字,F列が文字列,G列が数字となっています。 この,D列~G列の中で,「コンボボックス」4つで指定したデータを別のSheetで表示させたいと考えています。 エクセルは,表計算やグラフならある程度使いこなせるのですが,マクロは全くの素人です。 お手数をお掛けしますが,どなたか知恵を授けてください。 よろしくお願いします。

  • エクセルのセルをクリックしてワードへ入力

    ワードとエクセルとを開いて、ワードで文章を作っていき、エクセルの適宜のセルに入力した文字列をワードのカーソルポイントへ入力したいとき、エクセルの前記文字列のセルの左隣のセルをクリックするだけで、前記文字列を入力できるようにしたいのですが、VBとかで、マクロを組まないとだめでしょうか、教えてください。

  • エクセル マクロ 条件に応じてロック

    エクセル2002を使用しています。 1行目のG1に”ロック”という文字列が入っていたら 2行目のG列の1つ前のF列で”A2:F2”まで、セルをロックしたいのですが、 どのようにマクロを書けばいいでしょうか? (”ロック”の文字列は、1行目には1つしか入りません。) できれば、エクセル2000でもマクロが対応できると嬉しいです。

  • エクセルの検索マクロについて

    今までオートフォーマットで検索していたのですが,一つの列に存在するデータが多量になったため,マクロを使った検索としたいです。 検索の方法として,「コンボボックス」で選択したデータを検索したいと考えています。 現状は以下の通りです。 ○検索元となるデータは,1つのSheetにまとめてあります。 ○「コンボボックス」で指定したいデータは4つあります。 ○検索元のSheetの,D列が文字列,E列が数字,F列が文字列,G列が数字となっています。 この,D列~G列の中で,「コンボボックス」4つで指定したデータを別のSheetで表示させたいと考えています。 エクセルは,表計算やグラフならある程度使いこなせるのですが,マクロは全くの素人です。 自分の力で解決しようと,色々試しましたが無理でした・・・ お手数をお掛けしますが,どなたか知恵を授けてください。 よろしくお願いします。

  • エクセルのマクロ(検索)

    お世話になります。 エクセルのマクロで以下の処理をしたいのですがアドバイスください。 Excel2002です。 以下は実際の作業を簡略化したものです。 F列が●●という文字列で、かつE列が空白以外の行を検索した結果、 →対象行がない場合、【対象行はありません】というメッセージボックスを出し、OKをクリックしてマクロを終了させる →ある場合、1行目にオートフィルタを設定し、F列が●●という文字列で、かつE列が空白以外の行を表示させる(オートフィルタの機能で)ここでマクロの動作を一時停止させ、【続行】or【終了】が選択できるメッセージボックスを表示させる。 ここで【終了】をクリックすればマクロを終了させる。 【続行】をクリックすれば、いまオートフィルタで表示されている行のD列を値をすべて-1に変更する。次にオートフィルタを解除し、F列にある●●というセルをすべてクリア(空白)しマクロを終了させる。 アドバイスお願いします。

  • 検索後、削除や抽出するマクロ

    エクセルのシート1、A列の1~1500のセルにテキストが入力されており ある特定のテキストを含むセルを全て シート2のA列に抽出したいのですが、検索してみましたがうまくできません。 作業の流れとしては シート1のA列を範囲指定し、編集-検索、検索する文字列を入力し、すべてを検索をクリック 検索結果をコピーし、シート2のA列に貼り付ける もうひとつはシート1、A列の1~1500のセルにテキストが入力されており テキスト1またはテキスト2を含むセルを全て削除するというマクロを作成したいです。 ご指導のほどよろしくお願いいたします。