A 回答 (4件)
- 最新から表示
- 回答順に表示
No.4
- 回答日時:
度重なり申し訳ありません。
先ほどの回答に追記しておけばよかったのですが、
作業用シートにオートシェイプで「実行」や「検索」などを作成し、マクロを登録することで
入力→オートシェイプクリックでマクロを実行できるため、より手軽にご利用できるかと思います。
(作業用シートを印刷するとのことですので、
印刷設定を印刷しないにすると良いと思います)
http://www.konomiti.com/vba01_1.html
→ボタンからマクロを実行できるようにする。(マクロの登録)
が参考になるかと思います。
今回のマクロは
No2の添付画像にありますとおり、「*いか」で検索しますと「すいか」のようにワイルドカード検索(「*」を用いた検索)が行えます。
現状においてワイルドカードで複数一致する名前がある場合、一番初めに一致するものしか検索されない問題点があります。
(「*いか」でワイルドカード検索をした場合、「すいか」「するめいか」などが名簿にあると一致対象となりますが、今回のコードでは初めにヒットする「すいか」の行しか取得されません。)
おまけ機能の「del」を入れることで指定行の削除は、ワイルドカード検索を行った場合適用されません。
No.3
- 回答日時:
>作業用のシートを作成した後はプリントアウトします。
>名前と住所そして電話番号を入力しなければいけない書類なので、
>名前を検索してなるべく入力しなくても作成出来るようにしたいと考えてます。
そのご利用方法でしたら、「名簿」シートをNo2の添付画像のような様式で作成して頂き
以下の箇所を変更して頂ければご利用できると思います。
Set tar(0) = Sheets("作業用シート")
col1 = Split("A2,B2,C2", ",")
Set tar(1) = Sheets("名簿")
>名前を検索して登録されて無ければ、ついでに登録出来たら、
>次に作成する人は楽になると考えました。
>教えていただいたコードを参考に試してみます。
不都合あれば調整致しますので問題点、動作状況、目的等をご提示ください。
No.2
- 回答日時:
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", ",")
'△-------------------------------△
No.1
- 回答日時:
様式の提示がなかったため、勝手に作りました。
こんな感じでどうでしょ?
コードだけで文字制限限界なので説明は次の回答にまたぎます。
■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
いつもありがとうございます。
使っている様式が詳しく伝えられなくてすいませんでした。
作業用のシートを作成した後はプリントアウトします。名前と住所そして電話番号を入力しなければいけない書類なので、名前を検索してなるべく入力しなくても作成出来るようにしたいと考えてます。
名前を検索して登録されて無ければ、ついでに登録出来たら、次に作成する人は楽になると考えました。
教えていただいたコードを参考に試してみます。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
重複するidをデータごとにまと...
-
エクセルVBA Ifでシート名が合...
-
エクセルVBA 変数への代入がう...
-
【ExcelVBA】全シートのセルの...
-
エクセルVBAで次の様にデーター...
-
同じ作業を複数のシートに実行...
-
VBA オートフィルター繰り返し
-
VBAで同じシート名のコピー時は...
-
別のシートから値を取得するとき
-
エクセルのシート名変更で重複...
-
エクセルのマクロでアクティブ...
-
VBA ユーザーフォーム上のチェ...
-
【エクセル】オプションボタン...
-
Worksheet_Changeの内容を標準...
-
別のシートを参照して計算する方法
-
Excel VBA で自然対数の関数Ln...
-
Excel VBA 複数行を数の分だけ...
-
Excel VBAシートの色を一気に変...
-
Excel VBA 文字列のセルを反映...
-
VBA 入力月で該当シートを選択...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
特定の文字を含むシートだけマ...
-
excelのマクロで該当処理できな...
-
【ExcelVBA】全シートのセルの...
-
ユーザーフォームに入力したデ...
-
別のシートから値を取得するとき
-
ブック名、シート名を他のモジ...
-
実行時エラー'1004': WorkSheet...
-
Excelマクロのエラーを解決した...
-
XL:BeforeDoubleClickが動かない
-
シートが保護されている状態で...
-
エクセルのシート名変更で重複...
-
実行時エラー1004「Select メソ...
-
VBAで同じシート名のコピー時は...
-
エクセルで通し番号を入れてチ...
-
同じ作業を複数のシートに実行...
-
Excel VBA リンク先をシート...
-
ExcelのVBAのマクロで他のシー...
-
Vba UserformからExcelシートの...
-
【Excel VBA】Worksheets().Act...
-
VBA 存在しないシートを選...
おすすめ情報