プロが教えるわが家の防犯対策術!

Excel2013です。

別シートに名簿、作業用シートで名前を検索する、別シートにある名簿から検索された名前を選択すると、その名前の住所や電話番号が作業用シートに表示出来るようにしたいのですが、どなたかVBに詳しい方教えて下さい。
出来れば、名簿に無い場合は新規に登録出来たり、変更があったりしたら編集も出来て、重複してる場合は削除などが出来ればいいのですが。

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

A 回答 (4件)

度重なり申し訳ありません。



先ほどの回答に追記しておけばよかったのですが、
作業用シートにオートシェイプで「実行」や「検索」などを作成し、マクロを登録することで
入力→オートシェイプクリックでマクロを実行できるため、より手軽にご利用できるかと思います。

(作業用シートを印刷するとのことですので、
 印刷設定を印刷しないにすると良いと思います)

http://www.konomiti.com/vba01_1.html
→ボタンからマクロを実行できるようにする。(マクロの登録)

が参考になるかと思います。


今回のマクロは
No2の添付画像にありますとおり、「*いか」で検索しますと「すいか」のようにワイルドカード検索(「*」を用いた検索)が行えます。

現状においてワイルドカードで複数一致する名前がある場合、一番初めに一致するものしか検索されない問題点があります。
(「*いか」でワイルドカード検索をした場合、「すいか」「するめいか」などが名簿にあると一致対象となりますが、今回のコードでは初めにヒットする「すいか」の行しか取得されません。)

おまけ機能の「del」を入れることで指定行の削除は、ワイルドカード検索を行った場合適用されません。
    • good
    • 0

>作業用のシートを作成した後はプリントアウトします。


>名前と住所そして電話番号を入力しなければいけない書類なので、
>名前を検索してなるべく入力しなくても作成出来るようにしたいと考えてます。

そのご利用方法でしたら、「名簿」シートをNo2の添付画像のような様式で作成して頂き
以下の箇所を変更して頂ければご利用できると思います。

Set tar(0) = Sheets("作業用シート")
col1 = Split("A2,B2,C2", ",")
Set tar(1) = Sheets("名簿")


>名前を検索して登録されて無ければ、ついでに登録出来たら、
>次に作成する人は楽になると考えました。
>教えていただいたコードを参考に試してみます。

不都合あれば調整致しますので問題点、動作状況、目的等をご提示ください。
    • good
    • 0

No1の解説になります。




■VBAコードの追加方法
(1)Alt+F11で「Microsoft Visual Vasic」を開きます
(2)「挿入→標準モジュール」で新規モジュールを作成
(3)作成されたモジュールにNo1のVBAコードを全て貼り付けてください

現在の設定では添付画像のような様式で動作いたします。
(ただし、作業用シートと名簿のシートは同じブック内である必要があります)

★★★★★★必ず!★★★★★
いきなり本番で利用せず、画像のサンプルデータと同じものを作成のうえ、動作確認お願いします


■基本的な使い方
(1)「作業用シート」のセル「A2」に検索したい名前を入力
(2)エクセルメニューの表示→マクロ→「取得」を実行
(3)「名簿」シートの「A」列を検索し一致した場合の住所と電話を「作業用シート」のセル「B2」「B3」に表示されます
(4)一致しなかった場合は確認のダイアログが表示され、新規追加処理にうつります。


■新規追加処理について
基本的な使い方の(4)で新規追加用のダイアログが表示されます
「○○,△△」のように住所と番号をカンマ「,」で区切り指定してください。
(この場合の○○は住所、△△は番号です)
指定した内容が名簿リストの最終行に追加されます


■更新をする場合
(1)「作業用シート」のセル「A2」に対象の名前を入力
(2)「作業用シート」のセル「B2」「C2」に更新後の住所、電話を入力
(3)基本的な使い方の(2)と同様に「取得」を実行
(4)このとき、(1)の対象が見つからなければ新規追加処理にうつります。
(5)一致した名前が見つかれば(2)で入力した内容で「名簿シート」が更新されます。


■重複している場合
基本的な使い方で「A2」で指定した名前が重複している場合は重複削除の確認表示がでます。
「はい」をクリックで一番上の一つを残して「名簿シート」から対象の重複行が削除されます。
(注意!!!!!)
住所、番号の重複チェックはしておらず、名前が重複しているかどうかで判断しています。
名前が同じであれば、住所、番号が異なっていても削除されます。


■指定削除(おまけ機能)
(1)セル「A2」に対象の名前を入力します
(2)セル「B2」に「del」を入力します
(3)マクロ「取得」を実行すると指定した名前の行が名簿シートから削除されます


■設定変更
コード内の以下の場所を変更することである程度のフォーマットの変化に対応できます。
(1)「作業用シート」や「名簿シート」が以下の「"作業用シート"」、「"名簿"」の部分になります。
  必要に応じて変更してください。

(2)"A2,B2,C2"が「作業用シート」において、入力・設定・取得する「名前、住所、電話」のセルになります。
  変更する場合は「名前」「住所」「電話」セルの順番でカンマ「,」で区切って指定してください。

(3)"A,B,C"が「名簿シート」において、名前、住所、電話のセル記号になります。
  変更する場合は「名前」「住所」「電話」の列記号の順番でカンマ「,」で区切って指定してください。

'▽設定---------------------------▽
Set tar(0) = Sheets("作業用シート")
col1 = Split("A2,B2,C2", ",")
Set tar(1) = Sheets("名簿")
col2 = Split("A,B,C", ",")
'△-------------------------------△
「VBA Excel 名簿を検索」の回答画像2
    • good
    • 0

様式の提示がなかったため、勝手に作りました。


こんな感じでどうでしょ?
コードだけで文字制限限界なので説明は次の回答にまたぎます。

■VBAコード

Option Explicit
Dim tar(1) As Worksheet
Dim col1, col2, dat


Sub 取得()
Dim rmax As Long

Dim hit As Long
Dim inp As String
Dim flag, del

'▽設定---------------------------▽
Set tar(0) = Sheets("作業用シート")
col1 = Split("A2,B2,C2", ",")
Set tar(1) = Sheets("名簿")
col2 = Split("A,B,C", ",")
'△-------------------------------△

With tar(1)
rmax = .Range(col2(0) & Rows.Count).End(xlUp).Row
hit = 検索(.Range(col2(0) & "1:" & col2(0) & rmax), tar(0).Range(col1(0)))
If hit < 0 Then
'重複した場合→削除確認→(削除処理)→終了
If MsgBox("""" & tar(0).Range(col1(0)) & """の重複行を削除しますか?", vbYesNo, "重複しています") = vbYes Then
MsgBox "削除数/重複数:" & 重複(.Range(col2(0) & "1:" & col2(0) & rmax), rmax, tar(0).Range(col1(0)), Abs(hit)), vbOKOnly, "削除しました"
End If
Exit Sub
End If
If hit = 0 Then
'見つからなかった場合→追加確認→(追加処理)→終了
If MsgBox("""" & tar(0).Range(col1(0)) & """を追加しますか?", vbYesNo, "名前が見つかりません") = vbYes Then
inp = InputBox("住所と電話をカンマ「,」で区切って入力してください", "登録します", "住所,電話")
If inp <> "" Then
dat = Split(inp, ",")
tar(1).Range(col2(0) & rmax + 1) = tar(0).Range(col1(0))
tar(1).Range(col2(1) & rmax + 1) = dat(0)
tar(1).Range(col2(2) & rmax + 1) = dat(1)
MsgBox "追加しました"
Else
GoSub cn1
End If
Else
GoSub cn1
End If
tar(0).Range(col1(1), col1(2)).ClearContents
Else
'見つかった場合→削除チェック
If Len(tar(0).Range(col1(1))) + Len(tar(0).Range(col1(1))) > 0 Then
'削除チェック
If tar(0).Range(col1(1)) = "del" Then
'削除確認→(削除処理)
del = MsgBox("""" & tar(1).Range(col2(0) & hit) & """を削除しますか?", vbYesNoCancel, "確認")
If del = vbYes Then
MsgBox """" & tar(1).Range(col2(0) & hit) & """を削除しました"
tar(1).Rows(hit).Delete
End If
If del = vbCancel Then GoTo cn2
Else
'更新確認→(更新処理)
flag = MsgBox("""" & tar(1).Range(col2(0) & hit) & """を更新しますか?", vbYesNoCancel, "住所または電話が空欄ではありません")
If flag = vbYes Then
tar(1).Range(col2(1) & hit) = tar(0).Range(col1(1))
tar(1).Range(col2(2) & hit) = tar(0).Range(col1(2))
MsgBox """" & tar(1).Range(col2(0) & hit) & """を更新しました"
End If
If flag = vbCancel Then GoTo cn2
End If
End If
'削除・更新以外で取得
If del <> vbYes And flag <> vbYes Then
tar(0).Range(col1(1)) = tar(1).Range(col2(1) & hit)
tar(0).Range(col1(2)) = tar(1).Range(col2(2) & hit)
Application.ScreenUpdating = False
tar(1).Activate
tar(1).Rows(hit).Select
tar(0).Activate
Application.ScreenUpdating = True
MsgBox "取得しました"
End If
End If
End With
Exit Sub

cn1:
MsgBox "キャンセルされました"
Return

cn2:
MsgBox "キャンセルされました"
End Sub

Function 重複(tar_r As Range, rmax As Long, word As String, hit As Long) As String
Dim i As Long
Dim cnt As Long
Dim nrow As Long

For i = tar_r.Count To 1 Step -1
If tar_r.Cells(i) = word Then
nrow = tar_r.Cells(i).Row
If nrow <> hit Then
重複 = 重複 & vbCrLf & tar_r.Cells(i) & " (" & nrow & "行目)"
tar(1).Rows(nrow).Delete
End If
cnt = cnt + 1
End If
Next i
重複 = cnt - 1 & "/" & cnt & 重複
End Function


Function 検索(tar As Range, word As Variant)
Dim i As Long
Dim hit As Integer
On Error GoTo era
For i = 1 To tar.Count
If tar.Cells(i) = word Then hit = hit + 1
Next i
If hit > 1 Then 検索 = -1 * tar.Find(word).Row: Exit Function
検索 = tar.Find(word).Row
Exit Function
era:
検索 = 0
End Function
    • good
    • 0
この回答へのお礼

いつもありがとうございます。

使っている様式が詳しく伝えられなくてすいませんでした。

作業用のシートを作成した後はプリントアウトします。名前と住所そして電話番号を入力しなければいけない書類なので、名前を検索してなるべく入力しなくても作成出来るようにしたいと考えてます。
名前を検索して登録されて無ければ、ついでに登録出来たら、次に作成する人は楽になると考えました。
教えていただいたコードを参考に試してみます。

お礼日時:2014/07/05 14:44

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

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

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

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

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

QExcelでの名前検索

苗字、住所、電話番号が並んだ表があります。
苗字は当然のごとく重複してくるのですが、この苗字を検索した時に該当者全員分の住所、電話番号が出てくるようなセルを作りたいのですが可能でしょうか。
vlookupでの検索をイメージしていたのですが…。
フィルタで絞るにも200件からあるので探すのがめんどくさく、使用するときには時間がなかったりします。
という条件で、何かよい方法があったら教えて下さい。

Aベストアンサー

A~C列:住所録(リスト)
E2:検索する苗字(入力)
F2:住所
=IF($H2="","",INDEX(B$1:B$999,$H2))
G2:TEL
=IF($H2="","",INDEX(C$1:C$999,$H2))
H2:検索された場合の行数
=IF(ISERROR(MATCH($E$2,OFFSET($A$1,$H1,0):$A$999,0)),"",MATCH($E$2,OFFSET($A$1,$H1,0):$A$999,0)+$H1)
F2~H2、まとめて下に適当数コピー
H1は空白にすること。
最大行数は適当に変更。

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....続きを読む

QVBAのユーザーフォーム上で名簿を検索して転記する方法

来訪された方(ゲスト)のデータを入力するのに困っています。

エクセルには、
A列:ゲストの名前
B列:ID(任意)
C列:対応者の名前
D列以降:日付、ゲストの情報、対応内容情報など
が転記されるようにVBAのユーザーフォームで入力フォームを作りました。

しばらくはこのまま使用していましたが、同じゲストに対して数回対応することが多くなりました。
今は、
エクセルの検索機能で名前かIDを検索→
入力フォームを立ち上げて情報を入力しエクセルに転記→
一度フォームを閉じてから再びエクセルで検索をする→
入力フォームを立ち上げて情報を入力→
と続けており、かなり面倒です。


そこで、入力フォーム上で名前もしくはIDの検索をできるようにするVBAプログラムを教えていただけないでしょうか?

・たとえば「鈴木」と検索したら「鈴木Aさん」「鈴木Bさん」「鈴木Cさん」が候補として表示される。
・その候補名と一緒、それぞれのIDも同時に表示される。
・いずれかの「鈴木さん」を選んだら、ユーザーフォーム上のテキストボックス「name」と「id」に選んだ「鈴木さん」が入力される。
<できれば>
・候補名とIDのセットが重複していた場合は、1組だけ候補に表示されるプログラム
→同じゲストの数回分のデータが入力されているため

よろしくお願いいたします。

来訪された方(ゲスト)のデータを入力するのに困っています。

エクセルには、
A列:ゲストの名前
B列:ID(任意)
C列:対応者の名前
D列以降:日付、ゲストの情報、対応内容情報など
が転記されるようにVBAのユーザーフォームで入力フォームを作りました。

しばらくはこのまま使用していましたが、同じゲストに対して数回対応することが多くなりました。
今は、
エクセルの検索機能で名前かIDを検索→
入力フォームを立ち上げて情報を入力しエクセルに転記→
一度フォームを閉じてから再びエクセル...続きを読む

Aベストアンサー

質問を拝見してみて
別途、IDと名前のシートは準備されていないということでしょうか。
まずは、こちらを準備した方が良いでしょう。
現在あるデータの名前とIDの列を別のシートへコピー
エクセルのデータのリボンの中央近くに、重複の削除がありますので
クリックすれば重複が削除されます。
そのあとに名前順、或いはID順に並び替えておいて
ユーザーフォームで名前を選択する際には、Comboboxにしておき
ドロップダウンのリストから名前を選択するようにすれば如何でしょうか。
但し、同性同名の方も考慮すると
会員カードを配布するなどして、最初に IDが分かるようにした方が
良いと思います。

一例ですが、
別シート上に、Vlookup関数でIDに対して名前など表示されるセルを準備しておく。
Combobox1にIDを入力
Combobox1_Change()
Vlookup関数の検索値を入れているセル=Combobox1.Value
Textbox1"名前を表示させるテキストボックス Or Label=Vlookup関数を入れてあるセル


とかすれば、自動で選択したIDに対しての名前など情報が次にテキストボックスなどに
引っ張って来れます。

質問を拝見してみて
別途、IDと名前のシートは準備されていないということでしょうか。
まずは、こちらを準備した方が良いでしょう。
現在あるデータの名前とIDの列を別のシートへコピー
エクセルのデータのリボンの中央近くに、重複の削除がありますので
クリックすれば重複が削除されます。
そのあとに名前順、或いはID順に並び替えておいて
ユーザーフォームで名前を選択する際には、Comboboxにしておき
ドロップダウンのリストから名前を選択するようにすれば如何でしょうか。
但し、同性同名...続きを読む

QExcel VBA 検索して該当行を抽出

はじめまして、下記のように、Excelでマクロを組みたいのですが
組み方がわかりません。
ご教授願えませんでしょうか。

MS Ofiice2010 生徒数500名ほど
シート1には生徒の生徒番号、氏名などがあります。
     A     B     C     D
1 生徒番号   氏名   備考
2 120001     田中
3 120002     山田  試験時休み
4 T120009    相田   転入

シート2には生徒の成績表:生徒番号、氏名、国語、算数、理科、社会
生徒番号でソートされていません。
     A     B     C     D     E     F   
1 生徒番号   氏名   国語   算数   理科   社会  
2 120001     田中   80    65     65     75
3 T120009    相田   90    85     80     80

シート1の生徒番号でシート2生徒番号を検索して、該当したら成績を
シート1の検索した生徒番号のD列以降にコピーしたいのですが
     A     B     C     D     E     F     G
1 生徒番号   氏名   備考   国語   算数   理科   社会
2 120001     田中         80    65     65     75
3 120002     山田  試験時休み


10 T120009    相田   転入    90    85     80     80

お手数ですが、ご教授願えますでしょうか。
よろしくお願いいたします。

はじめまして、下記のように、Excelでマクロを組みたいのですが
組み方がわかりません。
ご教授願えませんでしょうか。

MS Ofiice2010 生徒数500名ほど
シート1には生徒の生徒番号、氏名などがあります。
     A     B     C     D
1 生徒番号   氏名   備考
2 120001     田中
3 120002     山田  試験時休み
4 T120009    相田   転入

シート2には生徒の成績表:生徒番号、氏名、国語、算数、理科、社会
生徒番号でソートされていません。
   ...続きを読む

Aベストアンサー

こんばんは!
関数ではダメですか?

Sheet1のD2セルに
=IF(COUNTIF(Sheet2!$A:$A,$A2),VLOOKUP($A2,Sheet2!$A:$F,COLUMN(C1),0),"")
という数式を入れオートフィルで列方向・行方向にコピー!

これで大丈夫だと思いますが・・・

※ どうしてもVBAでやりたい場合は、一例です。

Alt+F11キー → メニュー → 挿入 → 「標準モジュール」を選択 → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)

Sub Sample1() 'この行から
Dim i As Long, n As Long, c As Range, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")

For i = 2 To wS1.Cells(Rows.Count, 1).End(xlUp).Row
Set c = wS2.Columns(1).Find(what:=wS1.Cells(i, 1), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
n = c.Row
wS2.Cells(n, 3).Resize(1, 4).Copy wS1.Cells(i, 4)
End If
Next i
End Sub 'この行まで

こんな感じではどうでしょうか?m(_ _)m

こんばんは!
関数ではダメですか?

Sheet1のD2セルに
=IF(COUNTIF(Sheet2!$A:$A,$A2),VLOOKUP($A2,Sheet2!$A:$F,COLUMN(C1),0),"")
という数式を入れオートフィルで列方向・行方向にコピー!

これで大丈夫だと思いますが・・・

※ どうしてもVBAでやりたい場合は、一例です。

Alt+F11キー → メニュー → 挿入 → 「標準モジュール」を選択 → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)

Sub Sample1() 'この行から
...続きを読む

QExcel VBA 検索した値を入力フォームに表示

VBA初心者ながら、顧客管理用に入力フォームなどを作っています。

検索フォームを作成し、名前や住所などをキーワードに実行ボタンを押して検索すると、顧客シートからデータを引っ張ってきて、検索フォームの下に対象リストが表示されます。(今回の場合は顧客シートのNo1、12、17のデータを引っ張ってきています。)

そこから、イメージとしては、画像のように3件結果が出力された内、一番上の検索結果をクリックすると、入力フォームに選択した対象者の情報が表示されるようなことをしたいのですが、何から手をつけたらよいかがわかりません・・・。

ちなみに、検索フォームに表示される値は、実際の入力フォームに入力する項目より少ない(例えば、入力フォームでは「ふりがな」がありますが、検索フォームに検索結果としては「ふりがな」は表示されていません。)

かなり大雑把な質問ですが、アドバイスなど頂けると幸いです。

Aベストアンサー

リストで選択したデータが存在する行番号が rowNumber に正しく取得できていますか?
私のサンプルで想定している環境は以下のように想定しています。

・ データ群が書き込まれているシートの 1行目が項目名になっていて、2行目からデータが入力されている。
・ 1つのデータは 1行で完結する。
・ 1列目(A列)には抜けもれなく通し番号が振ってある。(1件目の A2 が 1 で、 2件目の A2 が2、以下 1ずつ増えていっている)
・ 検索フォームのリストボックスの 1列目は、データ群のシートの A列の値(通し番号)が表示されている。

という状況なので、
1. 検索結果のリストから 1つのクリックする。
2. クリックされたリスト項目の 1列目の値をもとに、元の場所の行番号を割り出す。(元のデータのシートは 2行目からデータが始まっているのでリスト項目 1列目の値に 1 を加算すれば元の行番号になる)


もし以下のような環境だと、選択したリスト項目の内容から元のデータの行番号を推察することができません。
・ データ群のシートの 1列目は ID となっていて、改廃されていくと番号が飛ぶこともある。
・ 検索フォームのリストの 1列目は ID の値である。

この場合はリストボックスの 1列目に隠し列を作って起き、元の行番号を表示させておくのはどうでしょうか。
1列目の列幅を 0 pt にすれば見えません。(ColumnWidth プロパティ)

リストで選択したデータが存在する行番号が rowNumber に正しく取得できていますか?
私のサンプルで想定している環境は以下のように想定しています。

・ データ群が書き込まれているシートの 1行目が項目名になっていて、2行目からデータが入力されている。
・ 1つのデータは 1行で完結する。
・ 1列目(A列)には抜けもれなく通し番号が振ってある。(1件目の A2 が 1 で、 2件目の A2 が2、以下 1ずつ増えていっている)
・ 検索フォームのリストボックスの 1列目は、データ群のシートの A列の値(通し番号)...続きを読む

Qエクセルで複数の条件を抽出し自動的に別シートに反映する方法を教えてください。

こんばんは。教えてください。

元データ(sheet1)を更新するたび
2つの条件にあったデータを
別シートに自動的に抽出したいので
適した関数がありましたら教えてください。



◇シート1◇ ※元データ
 A      B     C     D     F
1 氏名 役職 部署 年齢 移動時期     
2 山田 社員 開発 45  未調整
3 田中 社員 人事 42  4/1~
4 鈴木 派遣 企画 30  
5 高橋 役員 人事 50  未調整
6 坂野 社員 企画 33  未調整  
7 井上 派遣 企画 29  未調整

◇シート2◇ ※部署が人事で移動時期が未調整の人のみ抽出
 A      B     C     D    F
1 氏名 役職 部署 年齢 移動時期 
2 高橋 役員 人事 50  未調整


補足
・元データ(シート1)はこれからもデータを追加するので
 その度、シート2、シート3もそれぞれ自動で反映されるようにした いです。

・マクロ、VBAは知識がないので
 関数で作成したいです。

・できるだけエラー(#N/Aなど)表示されないようにしたいです。

説明が不十分で伝わりにくいかと思いますが
よろしくお願いします。

こんばんは。教えてください。

元データ(sheet1)を更新するたび
2つの条件にあったデータを
別シートに自動的に抽出したいので
適した関数がありましたら教えてください。



◇シート1◇ ※元データ
 A      B     C     D     F
1 氏名 役職 部署 年齢 移動時期     
2 山田 社員 開発 45  未調整
3 田中 社員 人事 42  4/1~
4 鈴木 派遣 企画 30  
5 高橋 役員 人事 50  未調整
6 坂野 社員 企画 33  未調整  
7 ...続きを読む

Aベストアンサー

> 部署を"人事"と"企画"の両方で抽出する条件を追加する

おはようございます、merlionXXです。
Operator:=xlOr, Criteria2:="=企画" と、OR条件で"企画"を加えれば可能です。
一応、各コードの動きに解説もつけておきました。(解説は’でコメントアウトしてますのでこのまま貼り付けてもOKです。)

Private Sub Worksheet_Activate() 'このシートがアクティブになったら自動実行
With Sheets("Sheet1") 'Sheet1対して
.AutoFilterMode = False 'オートフィルタ終了(あればエラーになるため)
.Range("A1:E1").AutoFilter 'A1:E1にオートフィルタ設定
.Range("A1:E1").AutoFilter Field:=3, Criteria1:="=人事", Operator:=xlOr, Criteria2:="=企画" '左から3つ目のフィルタを"人事"と"企画"のOR条件で抽出
.Range("A1:E1").AutoFilter Field:=5, Criteria1:="未調整" '左から5つ目のフィルタを"未調整"で抽出
.Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy Range("A1") 'A1から最終セル範囲の可視セルをこのシートのA1以降に貼り付け
.AutoFilterMode = False 'オートフィルタ終了
End With 'Sheet1に対する記述おわり
End Sub

> 部署を"人事"と"企画"の両方で抽出する条件を追加する

おはようございます、merlionXXです。
Operator:=xlOr, Criteria2:="=企画" と、OR条件で"企画"を加えれば可能です。
一応、各コードの動きに解説もつけておきました。(解説は’でコメントアウトしてますのでこのまま貼り付けてもOKです。)

Private Sub Worksheet_Activate() 'このシートがアクティブになったら自動実行
With Sheets("Sheet1") 'Sheet1対して
.AutoFilterMode = False 'オートフィルタ終了(あればエラーになるた...続きを読む

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さんのおっしゃっていることも、もっともなのですが、気になる点がありましたので、自分のことを踏まえて、書かせていただきます。

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

Qある範囲のセルから任意の値を検索して、その隣のセルの値を取得するという関数はありますか?

Excelの関数について質問します。
ある範囲のせるを検索して、その隣のセルの値を取得するという関数を探しています。
なければユーザー定義で作りたいと思っています。
VLOOKUP関数では一番左端が検索されますが、
それをある範囲まで拡張して、
その右隣の値を取得できるようにしたいのです。
どうかお知恵をお貸しください。

Aベストアンサー

●X1セルの値を範囲A1:F200の中から探して、その右隣のセルの値を返す

 =OFFSET(A1,SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1))-1,SUMPRODUCT(COLUMN(A1:F200)*(A1:F200=X1)))

※最初のA1はワークシートの左上隅を示すものなので、検索範囲に関わらずA1固定
※SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1)) ⇒ A1:F200で値がX1と一致するセルの行番号

>その「ある範囲」の中には検索したい値が入っているセルは1つしかありません。
というのが前提です。複数のセルがHITすると関係ないセルの値が返るので、
場合によっては、IFをかぶせてCOUNTIFで確認した方が良いかもしれません。
 ex. =IF(COUNTIF(A1:F200,X1)=1,【上記数式】,"えらー")

ちなみに、VBAでやるならこんな感じになるかと。

動作の概要
 【検査範囲】から【検査値】を探し、
 最初にHITしたセルについて、右隣のセルの値を返す。
 ex. =Sample(X1,A1:F200)

'--------------------------↓ココカラ↓--------------------------
Function Sample(ByVal 検査値 As Variant,ByVal 検査範囲 As Range)
 For Each セル In 検査範囲
  If セル = 検査値 Then Exit For
 Next セル
 Sample = セル.Offset(0, 1)
End Function
'--------------------------↑ココマデ↑--------------------------

いずれもExcel2003で動作確認済。
以上ご参考まで。

●X1セルの値を範囲A1:F200の中から探して、その右隣のセルの値を返す

 =OFFSET(A1,SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1))-1,SUMPRODUCT(COLUMN(A1:F200)*(A1:F200=X1)))

※最初のA1はワークシートの左上隅を示すものなので、検索範囲に関わらずA1固定
※SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1)) ⇒ A1:F200で値がX1と一致するセルの行番号

>その「ある範囲」の中には検索したい値が入っているセルは1つしかありません。
というのが前提です。複数のセルがHITすると関係ないセルの値が返るので、
場...続きを読む

Qエクセル管理の名簿から必要な名簿だけを抽出したいんですが

windowsXPとエクセル2002を使ってますが、エクセルで管理している名簿(住所録)から、共通のキーワードを使ってまとめて検索・抽出する、良い方法はありませんか?
例えば宛名が「パン工場」「チーズ工場」「ジャム工場」のようにある場合、キーワードを「工場」というくくりだけでデータを抽出したいのです。
因みに「フィルターオプションの設定」だと、同一セルの中に他の語彙や文字が入っていると、除外されてしまいます。
例)キーワード「すし」⇒「すし屋」×(抽出されず)、といったような感じです。「Ctrl+F」ですと一つ一つ拾わないといけないので、大容量のデータですと、全て見つけ出すのに大変な労力と時間が掛かってしまいます。上記以外で何か良い方法はないでしょうか?よろしくお願いいたします。

Aベストアンサー

フィルタオプションで「工場」「を含む」とするだけで良さそうな気がしますが……。
どんな操作をされたのでしょうか?

QエクセルVBA 複数の条件を含む対象を抜き出す。

エクセルVBAについて質問です。
エクセルのバージョンは2003と2007を主に使用しています。

下記の様なデータがあるときに、部活が「野球」でかつクラブは「囲碁」に入っている生徒の学籍番号を別のシート(Sheet2)のB3から下に順にリスト化するマクロがどうしても出来なくて困っています。
find next等を使うのでは無いかと色々してみましたが上手く出来ない現状です。

<sheet1>
   A      B      C       D    E

1 学籍番号 学年    名前     部活   クラブ
2 2222222   1   山田 太郎  野球   囲碁
3 9854923   2   吉田 次郎   剣道   絵画  
4 1111111   3   佐藤 三郎  野球   囲碁
5 8888883   1   米山 権蔵  卓球   囲碁

Aベストアンサー

こんばんは!
Sheet1のA列(学籍番号)のみをSheet2のB3セル以降に表示すれば良いわけですね?
一例です。

画面左下のSheet1のSheet見出し上で右クリック → コードの表示 → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。

Sub test()
Dim i, k As Long
Dim ws As Worksheet
Set ws = Worksheets(2)
k = 2
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 4) = "野球" And Cells(i, 5) = "囲碁" Then
k = k + 1
ws.Cells(k, 2) = Cells(i, 1)
End If
Next i
End Sub

こんな感じではどうでしょうか?m(_ _)m


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

人気Q&Aランキング