[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『自働値を検索する』（寧々）
今現在値の検索を関数でしていますが、
データーが多いためすごく重くなっています。
それをＶＢＡに変更できないか投稿しました。
名簿シートのＧ列に住所を入力後
郵便番号と地区が自働表示できるようにしたいです。
郵便番号と地区の値は郵便番号シートから引っ張ります。
何か方法ありませんか？ご指導よろしくお願いします。
名簿シート
[A] [B] [C] [D] [E] [F} [G] [1] 地区 郵便番号 番地 [2] 西 １２３−４５６７ 西新宿１２３４ 東 １２３−４５６８ 澁谷２３４５ 西 １２３−４５６９ 青山１２−４６アパート 南 １２３−４５７０ 南沖縄１２３４ 北 １２３−４５７１ 北海道１２３４
郵便番号シート
[A] [B] [C] [1] 字名 郵便番号３ 地区 [2] 西新宿 １２３−４５６７ 西 [3] 澁谷 １２３−４５６８ 東 [4] 青山 １２３−４５６９ 西 [5] 南沖縄 １２３−４５７０ 南 [6] 北海道 １２３−４５７１ 北
>今現在値の検索を関数でしています どのセルにどんな関数を設定しているのか？ 記述してください。
>データーが多いためすごく重く 因みに名簿シート及び、郵便番号シートのデータは、それぞれ何行ぐらいですか？
VBAでやるとなると、おそらくWorksheetのChangeイベントを活用する事になりそうですが、 上記一行で何を意味するのか わかりますか？
もし、分からないなら、このWorksheetのイベントは？ Changeイベントは？ 等々から調べてみてください。調べて結果、分からない事柄をピンポイントで質問してください。
WorksheetのChangeイベントを活用するの意味なんて、当然分かります ということなら、 この中身のコードの問題になりますから、現在の関数の内容が大きなヒントになるかと思います。
ichinose
EXCEL のバージョンがありませんが、単に関数の計算が重いという事でしたら、 計算後に関数を値に置き換えてはどうでしょうか。
操作がいちいち面倒な場合は、2003 でしたらこんな方法でもできます。 http://takashixxx.blog88.fc2.com/blog-entry-2.html 2007、2010 でしたらクイックアクセスツールバーが、2010 でしたら ユーザ定義タブも 同様のことができます。
VBA での処理であれば、まずは現在使用している数式を提示されてはどうでしょうか。 (Mook)
ichinose さん (Mook) さん ありがとうございます。WorksheetのChangeイベントもためしてみました。 VBAについていろいろ調べました。 VBA関数て言う物もあるんですね＾＾
しかししょっぱなから躓いてしまいました。
西新宿１２３４ の場合 → 「西新宿」だけをとりだしす方法が分からずじまいです。＞＜
5日間やってまだ4行です T0T
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 7 Then Exit Sub
For Each c In Target
MyRs = c.Offset(, 5).End(xlUp).Row
数式です。以前教えていただきました。＾＾ IF(G2 = "","",VLOOKUP(LEFT($G2,MATCH(0,INDEX(0/(MID($G2,ROW($1:$1000),1)+1),),0)-1),郵便番号!$A$1:$B$99,2,0))
寧々
>西新宿１２３４ の場合 → 「西新宿」だけをとりだしす方法が分からずじまいです。 提示されえた数式と同じ規則で取り出すなら、
Option Explicit
Option Compare Text 'これ大事
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim crng As Range
Set rng = Application.Intersect(Target, Range("g2:g" & Rows.Count))
If Not rng Is Nothing Then
For Each crng In rng
MsgBox get_to_num(crng)
Next
End If
End Sub
Function get_to_num(ByVal rng As Range) As String
Dim tstr As String
Dim g0 As Long
tstr = rng.Value
get_to_num = ""
For g0 = 1 To Len(tstr)
If Mid(tstr, g0, 1) Like "[0-9]" Then
Exit For
End If
Next
If g0 > 1 Then get_to_num = Left(tstr, g0 - 1)
End Function
こんな感じで取り出せます。
西新宿１２３４ → 「西新宿」が取り出せれば、
後は、VBA内で Vlookupを使うには、どうすればよいかです。
私は、Application.VlookUp という書式で使うことが多いですが、 これも調べえ見てください
ichinose
ichinoseさんありがとうございます。 Application.VlookUp も調べてみました＾＾ ただ頂いたコード中の検索値が分からないですが、、、、
Function get_to_num ていうのは 西新宿１２３４ の場合 → 「西新宿」だけを取り出す部分になりますか？
Private Sub Worksheet_Change は入力時のアクションを起こすの意味合いでよろしいでしょうか？
そうしますと。 get_to_num ＝ 郵便シートの 字名 になりますか？
寧々
Sub test()
Dim myR
Dim myR2
Dim MR
On Error GoTo ErrorHandler
With Worksheets("郵便番号")
'MR = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
myR = Application.WorksheetFunction.VLookup(.Range("D1"), .Range("A:C"), 3, False)
myR2 = Application.WorksheetFunction.VLookup(.Range("D1"), .Range("A:C"), 2, False)
.Range("E1").Value = myR
.Range("F1").Value = myR2
End With
Exit Sub
ErrorHandler:
Worksheets("郵便番号").Range("E1").Value = "該当無し"
Worksheets("郵便番号").Range("F1").Value = "該当無し"
End Sub
TEST を Private Sub Worksheet_Change くみいれると全く動かないです。
「引数は省略できません」とエラーがでてきました。
全く見当違いで使用していますが？
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim crng As Range
Dim MR
Set rng = Application.Intersect(Target, Range("g2:g" & Rows.Count))
With Worksheets("名簿")
MR = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
If get_to_num = MR Then
.Range(MR & "B").Value = Application.WorksheetFunction.VLookup(get_to_num, Worksheets("郵便番号").Range("A:C"), 3, False)
.Range(MR & "G").Value = Application.WorksheetFunction.VLookup(get_to_num, Worksheets("郵便番号").Range("A:C"), 2, False)
End If
End With
End Sub
寧々
>ただ頂いたコード中の検索値が分からないですが、、、、 投稿したコードをもう少しだけ説明します。
投稿コードは、名簿というシートのモジュールに記述します。 Worksheet_Change イベントプロシジャーは、セルにデータが入力されると、 実行されます。入力されたセルが何なのか？は、Targetというパラメータが 教えてくれます。
但し、このコード内では
Set rng = Application.Intersect(Target, Range("g2:g" & Rows.Count))
If Not rng Is Nothing Then
このIF文の分岐でＧ列（正確には、G1は除く）に入力された場合だけ、
処理されるようになっています。
そのキーとなるのが
Application.Intersectメソッドです。このメソッドの意味がわからなければ、
次行のIF文でどんな場合だけ処理されるのかがきちんと理解できないはずです。
Application.Intersectメソッドをよく調べてください。
このChangeイベントプロシジャー内では、よく使われるメソッドですから、
これは押さえておいてください。
入力されたＧ列のセル（rng）に対して
For Each crng In rng
MsgBox get_to_num(crng)
Next
というように繰り返し処理をしているのは、
Excelシートというのは、一度に複数のセルに入力することが可能になっているからです。
つまり、複数のＧ列のセルに同時に入力された場合も考慮して、それぞれのセルでも処理される
ようにFor文を使っています。
では、このFor文内の
MsgBox get_to_num(crng) ‘のget_to_num関数とは？
試しに 名簿 シートのセルＧ２に 中央1598 と入力してみてください 中央 がメッセージ表示されますよね？
続いて、G3に セクシャルバイオレットナンバー1 と入力してみてください セクシャルバイオレットナンバーとメッセージ表示されますよね？ つまり、Ｇ列に入力された文字列を最初から1文字ずつ調べて、数字を検出したら、 その手前までの文字列を取得し、表示しているのです。
よって、「指定されたセルの入力文字列を最初から1文字ずつ調べて、数字を検出したら、 その手前までの文字列を取得する」、これがファンクションプロシジャー get_to_numの 機能ということになります。 get_to_num(crng) で得られた文字列こそが 検索値ということになります。
よって、get_to_num(crng)で得られた文字列で郵便番号シートA:C列をVlookupで検索すれば、 該当する郵便番号及び、地区が取得できることになります。
ということから、コードをちょっとだけ見てみると、
If get_to_num = MR Then
get_to_num は、引数が必須です（Rangeオブジェクト）から、エラーになりますよね。
以上です。再考してみてください。
Application.WorksheetFunction.VLookupは、私が普段使う書式とは違いますが、せっかくですから これでいきましょう。
ichinose
Application.Intersectはあるセルが、あるセル範囲内にあるかどうかを判定する
ことですね＾＾なんとなくイメージはわきました。
http://officetanaka.net/excel/vba/tips/tips118.htm
＞For Each crng In rng
＞ MsgBox get_to_num(crng)
＞ Next
はメッセージBOXでてます。
＞get_to_num(crng)
も分かりました。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim crng As Range
Dim MR
Dim yubin As Worksheet
Set rng = Application.Intersect(Target, Range("g2:g" & Rows.Count))
Set yubin = Worksheets("郵便番号")
With Sheets("名簿")
MR = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
If Not rng Is Nothing Then
'For Each crng In rng
.Range(MR & "G").Value = Application.WorksheetFunction.VLookup(get_to_num(crng), yubin.Range("A:C"), 2, False)
.Offset(, 1).Value = Application.WorksheetFunction.VLookup(get_to_num(crng), yubin.Range("A:C"), 3, False)
'Next
End If
End With
End Sub オブジェクト変数とWITH変数ブロックが設定されていません とエラーが出ました。いろいろ組み換えましたが、分かりませんでした。＾＾；； いったい何のヘマをやらかしたんでしょか?
Function get_to_num(ByVal rng As Range) As String
Dim tstr As String
Dim g0 As Long
tstr = rng.Value ’★エラー
get_to_num = ""
For g0 = 1 To Len(tstr)
If Mid(tstr, g0, 1) Like "[0-9]" Then
Exit For
End If
Next
If g0 > 1 Then get_to_num = Left(tstr, g0 - 1)
End Function
寧々
>Application.Intersectはあるセルが、あるセル範囲内にあるかどうかを判定する 田中さんのサイトは、「あるセルが、あるセル範囲内にあるかどうかを判定する」場合に Application.Intersectを使うと便利だよ という内容でApplication.Intersectの機能は、 「複数のセル範囲の共有セル範囲を表す Range オブジェクトを返します。」というものです。
Sub smp1()
MsgBox Application.Intersect(Range("a1:c3"), Range("a1:e2"), Range("a1:b2")).Address
End Sub
このコードの結果を理解してみてください。
提示されたコードについては・・・・、 あれれえ（コナン風）、サンプルコードで提示したFor〜Next文が消えてるよねえ・・・。 まっ、良いでしょう。For文も無しで行きましょう。
Option Explicit
Option Compare Text ‘これは、忘れない事
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
'Dim crng As Range ‘For文なしなので、とりあえず要らない
'Dim MR
Dim yubin As Worksheet
Set yubin = Worksheets("郵便番号")
Set rng = Application.Intersect(Target, Range("g2:g" & Rows.Count))
'これで Ｇ列と入力セルの共有セルを返すのですよね？
Set yubin = Worksheets("郵便番号")
With Sheets("名簿")
'MR = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
' If Not crng Is Nothing Then crngは、上で使われていないですよ！！
If Not rng Is Nothing Then 'Ｇ列のどこかのセルが入力されていれば？
Application.EnableEvents = False 'イベントの２重起動の防止
.Range("b" & rng.Row).Value = ""
.Range("b" & rng.Row).Value = Application.WorksheetFunction.VLookup(get_to_num(rng), yubin.Range("A:C"), 3, False)
.Range("f" & rng.Row).Value = ""
.Range("f" & rng.Row).Value = Application.WorksheetFunction.VLookup(get_to_num(rng), yubin.Range("A:C"), 2, False)
Application.EnableEvents = True 'イベントの２重起動の防止解除
End If
End With
End Sub
これで一見すると作動しているように見えます。 名簿シートのＧ列に番地を入力してみてください。
が、完成ではありませんよ！！エラー処理がされていませんから・・・。 エラーは、 On Error を使います。
一連の問答で感じたことは、やはり、もう少し基本は押さえられた方がよいですよ！！ HELPを参照してください。 それから、基本のステートメントは、学習してくださいね！！
ichinose
ichinoseさんありがとうございます。 VBAを理解する努力はしていますが（T0T) これが難問であります。
For〜Next文とってしまってすみません＞＜ 処理とのかみあいかたが、わからずにとってしまいました。もうしわけないです。
エラーを調べてやってみましたが、 http://officetanaka.net/excel/vba/tips/tips104.htm どうですか？ On Error GoTo 0を使うことによってイベントが中止にならなかったので。 本当はコメントも入れたいのですが、できませんでしたので断念です。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim crng As Range
Dim yubin As Worksheet
Dim ObjRange As Range
Set yubin = Worksheets("郵便番号")
Set rng = Application.Intersect(Target, Range("g2:g" & Rows.Count))
'複数のセル範囲の共有セル範囲を表す Range オブジェクトを返します
Set yubin = Worksheets("郵便番号")
On Error Resume Next
With Sheets("名簿")
If Not rng Is Nothing Then 'Ｇ列のどこかのセルが入力されていれば？
Application.EnableEvents = False 'イベントの２重起動の防止
.Range("b" & rng.Row).Value = ""
.Range("b" & rng.Row).Value = Application.WorksheetFunction.VLookup(get_to_num(rng), yubin.Range("A:C"), 3, False)
.Range("f" & rng.Row).Value = ""
.Range("f" & rng.Row).Value = Application.WorksheetFunction.VLookup(get_to_num(rng), yubin.Range("A:C"), 2, False)
Application.EnableEvents = True 'イベントの２重起動の防止解除
End If
End With
Exit Sub
On Error GoTo 0
End Sub
寧々
>VBAを理解する努力はしていますが（T0T) これが難問であります。 この問題、簡単ではありませんよ！！
>処理とのかみあいかたが、わからずにとってしまいました。 これについては、後回しにしましょう。
> On Error GoTo 0を使うことによってイベントが中止にならなかったので On Error GoTo 0は、イベントを中止にするためのステートメントではありませんよ！！
Sub test()
Dim a As Long
Dim b As Long
Dim c As Long
a = 5
b = 0
On Error Resume Next
'↑実行時エラーが発生してもプログラムを中断せず、エラーが発生したステートメントの次のステートメントから実行を継続します。
c = a / b 'エラーにならない
If Err.Number <> 0 Then MsgBox Err.Description
MsgBox "実行時エラーでプログラムは、中断していません"
On Error GoTo 0 'エラー処理を無効にします
c = a / b 'エラーになる 'ここから、実行時エラーでプログラムが止まる
End Sub
新規ブックの標準モジュールに上記のコードをコピーして実行してみてください。 同じ c = a / b というコードがエラーにならない場合とエラーになり、 プログラムが中断する場合があることを 確認し、その理由に納得してください。 これがOn Error GoTo 0 の機能です。
ポイントは、いいかげんにOn Error Resume Nextステートメントを設定するのではなく、 起こりうる可能性がある実行時エラーを想定し、そこのエラーを拾うために On Error Resume Nextステートメント設定するということです。
今回の場合、割り算の計算でB=0でエラーになる事を想定し、その直前に On Error Resume Nextステートメントを記述しています。
では、本題コードに戻れば、実行時エラーが起こる箇所は、
> Range("b" & rng.Row).Value = Application.WorksheetFunction.VLookup(get_to_num(rng), yubin.Range("A:C"), 3, False)
上記の検索で指定された字名が郵便シートのＡ列に存在しないとエラーが発生します。
よって、その直前にOn Error Resume Nextステートメントを設定し、
ここでエラー処理を施します。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim crng As Range
Dim yubin As Worksheet
Dim ObjRange As Range
Set yubin = Worksheets("郵便番号")
Set rng = Application.Intersect(Target, Range("g2:g" & Rows.Count))
'複数のセル範囲の共有セル範囲を表す Range オブジェクトを返します
Set yubin = Worksheets("郵便番号")
With Sheets("名簿")
If Not rng Is Nothing Then 'Ｇ列のどこかのセルが入力されていれば？
On Error Resume Next
Application.EnableEvents = False 'イベントの２重起動の防止
.Range("b" & rng.Row).Value = ""
.Range("f" & rng.Row).Value = ""
.Range("b" & rng.Row).Value = Application.WorksheetFunction.VLookup(get_to_num(rng), yubin.Range("A:C"), 3, False)
.Range("f" & rng.Row).Value = Application.WorksheetFunction.VLookup(get_to_num(rng), yubin.Range("A:C"), 2, False)
If Err.Number <> 0 Then MsgBox "指定住所は、見つかりませんでした" 'エラー時のメッセージ
Application.EnableEvents = True 'イベントの２重起動の防止解除
On Error GoTo 0
End If
End With
End Sub
この先、プログラミングを続けていけば、このOn Error Resume Nextステートメントを 使わなければならない事象は必ず出てきます。その時に正しくこれを使えるように しておかなければなりません。きちんとこれを押さえておかない方がとんでもない使い方で 正しく動作しないコードを何度か見かけたことがありますので、注意してください。
これで一応は、何となくは、作動していますし、これで完成でもまあ良いのですが・・・。 でも、Excelは、同時に複数のセルに入力することが可能です。 この時の対応が成されていません。エラーにならないだけです。 又、入力データのチェックもあと少し必要です。
これは、何度かお使いになって、細かい動作の不備を見つけてください。
Ichinose
On Error Resume Nextは
＞実行時エラーが発生してもプログラムを中断せず、エラーが発生したステートメントの次のステートメントから実行を継続します。
そうだったんですね。
例題を見つけた時もなんでコード間に入れているのか、しかも何か所も
これでようやく納得です。＾＾；；
＞これは、何度かお使いになって、細かい動作の不備を見つけてください。
はい。また何かありましたら、教えてください。理解遅いですが、よろしくお願いします。m(_ _)m
寧々
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.