Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

282 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【76796】Re:ファイルを開かずに郵便番号検索して...

ichinose - 15/3/13(金) 19:56 -


	引用なし

	パスワード

▼さとちぃさん：
>マクロのボタンを押せば一度に変換出来る
>ものを目指しております。

簡単な方法は、

>郵便番号一覧.xls

をADO用いて、ブックをDB　シートをテーブルに見立てて
検索す方法です。
接続文字列やSQLを調べると、比較的簡単に実現できます。
私が以前試した時、ブックに繋いだ直後の検索だけちょっと時間がかかりましたが、
その次からの検索はサクサク行えました。

もう一つは、日本郵便からダウンロードしたcsvを郵便番号データファイルと
住所ファイルに分けて、VBAで郵便場番号ファイルだけ読み込んで
検索を行う方法です。もちろん、二つのファイルはリンク付けされています。

郵便番号は、昇順に並べられていて、2分探索が使えるようにしておくと、
検索も速く行われます。

ただ、CVSファイルコンバートするコードと運用するコードが必要になります。

ADOで検索する方法を最初に試してみては　いかがですか？

>
>　　A　　　　　B　　　 C
>1　郵便番号　　県名　　住所
>2　504-0801　　岐阜県　美濃加茂市・・・
>3　111-0052　　北海道　札幌市・・・
>4
>
>
>EXCEL4.0については、インターネットにも情報があるのですが、検索を交えた
>サンプルを見つけることが出来ず困っております。
>
>よろしくお願いします。

・ツリー全体表示


	【76795】Re:ファイルを開かずに郵便番号検索して...

β - 15/3/13(金) 12:09 -


	引用なし

	パスワード

▼さとちぃさん：

こんにちは

「ファイルを開かずに」というリクエストは、ちょいちょい目にしますね。

>このファイルが17MBと非常にサイズが大きいため、ファイルを開かずに検索する方法を選択。

たとえ EXCEL4.0マクロを使ったとしても、ファイルはメモリー内に読み込まれています。
（そのはずです）

それが、デスクトップWindow に映し出されているかどうっかだけの違いです。
さらに、EXCEL4.0マクロは機能が限定的で、シート上の様々なものを柔軟に処理するには
かえって面倒で効率も悪いですよ。

１．Application.ScreenUpdating = False にして、通常にひらいて処理
２．あるいは、元々がCSVファイルなら、それこそ、ブックとして開くということではななく
　　もっと効率の良い参照ができますので、「加工」も含めて処理してしまうか
　　あるいは、この可能したファイルをエクセルブックとしてではなくCSVファイルとして保存しておいて
　　それを、CVSファイルとして効率の良い手法で参照。

いずれかがいいと思います。

・ツリー全体表示


	【76794】ファイルを開かずに郵便番号検索してコピ...

さとちぃ - 15/3/13(金) 11:04 -


	引用なし

	パスワード

お世話になります。
個人情報入力の工数削減として、郵便番号から自動で住所を入力するマクロを考えてます。

IMEで自動で変換等ありますが、今回、マクロのボタンを押せば一度に変換出来る
ものを目指しております。

（やりたいこと）
個人情報の入力欄に住所の入力項目があり、郵便番号から住所に
自動で変換するマクロを作成

(実現方法)

EXCEL4.0を用いたファイルを開かずに対象のエクセルファイルを検索する。
郵便番号の情報は、日本郵便からダウンロードしたcsvを加工したものを使用。
このファイルが17MBと非常にサイズが大きいため、ファイルを開かずに検索する方法を選択。

個人情報入力.xls

　氏名　部署　所属　郵便番号　　県名　　住所
1　田中　営業　1課　　504-0801
2　
3
4

郵便番号一覧.xls

　　A　　　　　B　　　 C
1　郵便番号　　県名　　住所
2　504-0801　　岐阜県　美濃加茂市・・・
3　111-0052　　北海道　札幌市・・・
4

EXCEL4.0については、インターネットにも情報があるのですが、検索を交えた
サンプルを見つけることが出来ず困っております。

よろしくお願いします。

・ツリー全体表示


	【76793】Re:シート1とシート2の内容で一致するも...

β - 15/3/12(木) 21:44 -


	引用なし

	パスワード

▼あやさん：

>判定をA列同士で行って、結果表示はSheet2の重複した横のB列を表示するというのをdl.Offset(0, 1)以外で思いつかないのですが、何か良い案はないでしょうか・・・
>それともdl.Offset(0, 1)を使って表示できるが、私の書き方がミスっているから表示できないのでしょうか・・・

ん？？
そうしてますよ。 c.Offset(,1) として B列の値を重複のいれもの（Dup)にいれてますが？

もしかして Test2 ？
地域表示は Test3 ですけど？

・ツリー全体表示


	【76792】Re:検索後のHTML解析

Satsuki - 15/3/12(木) 21:13 -


	引用なし

	パスワード

▼bant さん：
ご回答ありがとうございます。

>コード変更なしで検索出来たり出来なかったりしているので、
>タイミングの問題だと思っています。
Function getMaxPage(objIE)の中で一旦止まるようにして、
objIEの中身をウォッチウィンドウで見てみました。
objIE.LocationURLはきちんとプルダウン検索後のURLになっておりましたので、
引数の渡し方は間違っていないようです。
ところが、SelectPulldownMenuの値がobjIE.LocationURLと時々違うので、

Function SelectPulldownMenu(objIE) As String
　　objIE.document.forms("color")("color_id").Value = "5"
　　objIE.document.forms("color")("color_id").FireEvent ("OnChange")
　　Call WaitFor(3)
　　SelectPulldownMenu = objIE.LocationURL
End Sub
上記のようにCall WaitFor(3)をプルダウン検索後に移動したところ、
objIE.LocationURLの値がSelectPulldownMenuに入るようになりました。
おっしゃるとおり、タイミングの問題でした。
ご教示ありがとうございました。

またわからないことがありましたら、よろしくお願いいたします。

・ツリー全体表示


	【76791】Re:シート1とシート2の内容で一致するも...

あや - 15/3/12(木) 21:04 -


	引用なし

	パスワード

▼β さん：
判定をA列同士で行って、結果表示はSheet2の重複した横のB列を表示するというのをdl.Offset(0, 1)以外で思いつかないのですが、何か良い案はないでしょうか・・・
それともdl.Offset(0, 1)を使って表示できるが、私の書き方がミスっているから表示できないのでしょうか・・・

>▼あやさん：
>
>おっとぉ！
>難易度がぐ～んとアップしましたね。
>Dictionaryでの（直接）比較は、ワイルドカードがつかえませんので
>すべてをなめて、Like 判定をするという手もありますが、ちょっと別の方法を考えてみます。
>（老化進行防止のための、いいトレーニングになります）
>
>ところで、部分一致ですが
>
>Sheet2の語句がSheet3の語句と部分一致
>Sheet3の語句がSheet2の語句と部分一致
>
>どちらでしょうか？
>
>なお、重複表示をB列にすることは問題ありません。
>
>
>>▼β さん：
>>なるほど・・・
>>シート3で重複しているものも全て表示させようとしたため
>>dl.Add c.Valueという書き方をしているのですね。
>>また結果表示も同じものも表示させるために、重複を見つけるたびにv(i)に格納していくのですね。
>>有難うございます。
>>
>>またまた質問で申し訳ないのですが・・・
>>1.今回の処理はセル同士を見比べているので、セルの値が完全一致のものを表示させていると思うのですが、これを部分一致にさせることというのは可能なのでしょうか(lookat:=xlPartのような・・・)
>>2.見比べはシート2とシート3のA列で行うのですが、結果表示をさせるときにシート2のA列の結果ではなく、シート2のB列の結果を表示させる、ということは可能でしょうか。
>>(B列に地区名が入っていて、知りたいのは重複した名前の人の地区というような・・・
>>dl.Offset(0, 1)を使うとうまくいかなかったもので・・・)
>>
>>何度も申し訳ありません。
>>
>>>▼あやさん：
>>>
>>>まず、このコードは２つの入れ物を使っています。
>>> １つが Dictionary と呼ばれるもの。もう１つがArrayListと呼ばれるものです。
>>>いずれもＶＢＡの持ち物ではなく外部（.Net等）の機能なので、CreateObject で呼び出して使用。
>>>
>>>Dictionary は同じキーを格納した時に上書きされる特徴をもっていて、コードでは
>>>Sheet2の名前を格納するのに使っています。山田が何件あろうと１件の山田になります。
>>>
>>>ArrayListは、キー／データという概念はないのですが同じ値を別のものとして格納可能です。
>>>コードでは、重複のあったものを格納するのに使っています。Sheet3 に山田が３件あれば３件格納されます。
>>>また、ArrayListは格納されたものを昇順、降順に並び替える機能もあります。
>>>エラーメッセージで
>>>山田
>>> 佐藤
>>> 山田
>>> 佐藤
>>>とだすより
>>>山田
>>> 山田
>>> 佐藤
>>> 佐藤
>>>とだすほうがわかりやすいので、この昇順並び替え機能を使っています。（これが dl.Sort です）
>>>
>>>Dictionaryには、Existsメソッドがあり、ある値が、Dictionaryのキーとして格納されているかどうかの
>>>判定ができます。それが　dic.exists(c.Value)　で、このメソッドが返す結果が True なら　
>>> 重複しているということになりますので、それを dl.Add c.Value　でArrayList に登録しています。
>>>
>>>ArrayListに格納した内容は、ＶＢＡからは一挙に取り出せないので、ArrayListと同じ大きさの
>>>ReDim v(0 To dl.Count - 1)　で１次元配列をつくり、その配列に、ArrayListからインデックスを与えながら
>>>v(i) = dl(i)　で、データを取り出しておさめています。
>>> （ArrayListのインデックスは 0 から始まっています）
>>>
>>>さて、重複側を、あえてその件数だけすべて表示するという要望でしたのでArrayListを使いましたが
>>>集約して１件にして表示するなら、重複情報も ArrayListではなくDictionary に格納して重複をなくす
>>> ことができます。
>>>
>>> 以下でお試しください。
>>>
>>>Sub Test2()
>>>　　Dim dic As Object
>>>　　Dim dl As Object
>>>　　Dim i As Long
>>>　　Dim v As Variant
>>>　　Dim c As Range
>>>　
>>> 　　Set dic = CreateObject("Scripting.Dictionary")
>>>　　Set dl = CreateObject("Scripting.Dictionary")
>>>　
>>> 　　 With Sheets("Sheet2")
>>>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>>>　　　　　　dic(c.Value) = True
>>>　　　　Next
>>>　　End With
>>>　
>>> 　　 With Sheets("Sheet3")
>>>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>>>　　　　　　If dic.exists(c.Value) Then dl(c.Value) = True
>>>　　　　Next
>>>　　End With
>>>　
>>> 　　If dl.Count > 0 Then
>>>　　　　MsgBox "以下の重複がありました" & vbLf & Join(dl.keys, vbLf)
>>>　　Else
>>>　　　　MsgBox "重複はありませんでした"
>>>　　End If
>>>　
>>>End Sub

・ツリー全体表示


	【76790】Re:シート1とシート2の内容で一致するも...

あや - 15/3/12(木) 21:01 -


	引用なし

	パスワード

▼β さん：
返信が遅くなり、申し訳ありません。
毎回毎回丁寧に有難うございます。

因みに行いたかったのはSheet2の値がSheet3で部分一致するかどうかなので、下記ので試し、上手くいきました。本当にありがとうございます。

また悩み事が自身で解決できなくなりましたらまたご相談させてください・・・

>▼あやさん：
>
>以下は、Sheet2の値が部分一致でSheet3にあるかどうかをみています。
>不安ですが・・・
>試してみてください。
>
>Sub Test3()
>　　Dim reg As Object
>　　Dim dic As Object
>　　Dim Dup As Object
>　　Dim i As Long
>　　Dim v As Variant
>　　Dim c As Range
>　　Dim str3 As String
>　　
>　　Set reg = CreateObject("VBScript.RegExp")　 '文字列比較エンジン
>　　
>　　Set dic = CreateObject("Scripting.Dictionary")
>　　Set Dup = CreateObject("Scripting.Dictionary")
>　　
>　　'Sheet3の名前を取り出してDicに格納
>　　With Sheets("Sheet3")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　dic(c.Value) = True
>　　　　Next
>　　End With
>　　
>　　'Sheet3の各文字列を vbtab で挟み連結
>　　str3 = vbTab & Join(dic.keys, vbTab) & vbTab
>　　
>　　'Sheet2の各文字列をSheet3の連結文字列とワイルドカード比較
>　　With Sheets("Sheet2")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　'ワイルドカード比較パターン
>　　　　　　reg.Pattern = vbTab & ".*" & c.Value & ".*?" & vbTab
>　　　　　　'Sheet3側にあればSheet2のB列の値を格納
>　　　　　　If reg.Test(str3) Then Dup(c.Offset(, 1).Value) = True　　　　　　　　　　'
>　　　　Next
>　　End With
>　
>　　If Dup.Count > 0 Then
>　　　　MsgBox "以下の地域に重複がありました" & vbLf & Join(Dup.keys, vbLf)
>　　Else
>　　　　MsgBox "重複はありませんでした"
>　　End If
>　
>End Sub

・ツリー全体表示


	【76788】Re:検索後のHTML解析

bant - 15/3/12(木) 11:08 -


	引用なし

	パスワード

コード変更なしで検索出来たり出来なかったりしているので、
タイミングの問題だと思っています。
・表示完了後もう少し待ってみる。
・URLが初期ページの場合はもう一度検索する。
・検索の間隔が短くてはじかれているかもしれないので、もう少し間隔をあけてみる。
など試してみてはどうでしょうか。

・ツリー全体表示


	【76787】Re:AutoFilterで３つ以上の絞り込み方法

亜矢 - 15/3/12(木) 8:56 -


	引用なし

	パスワード

▼マナさん：
>無駄なことしているようなような気もしますが
>除外したいもの除いた配列を作成してはいかがでしょうか。
>
>Sub test()
>　　Dim a
>　　Dim d As Object
>　　Dim v
>　　Dim i As Long
>　　
>　　a = Array("田中", "土屋", "鈴木")
>　　
>　　Set d = CreateObject("scripting.dictionary")
>　　
>　　ActiveSheet.AutoFilterMode = False
>　　v = Range("a1").CurrentRegion.Columns(1).Value
>　　
>　　For i = 1 To UBound(v)
>　　　　d(v(i, 1)) = Empty
>　　Next
>　　
>　　For i = 0 To UBound(a)
>　　　　If d.exists(a(i)) Then d.Remove (a(i))
>　　Next
>　　
>　　Range("a1").CurrentRegion.AutoFilter Field:=1, _
>　　　　Criteria1:=d.keys, _
>　　　　Operator:=xlFilterValues
>　　
>End Sub
まだ完全解決とは行きませんが、参考にして研究してみます。
ありがとうございました。

・ツリー全体表示


	【76786】Re:検索後のHTML解析

Satsuki - 15/3/11(水) 23:03 -


	引用なし

	パスワード

▼banｔさん：
ご回答ありがとうございます。

>コードは変えずにうまくいったりだめだったりするのですね。
コードは少し変えています。
Sub SelectPulldownMenu(ByRef row, objDoc As HTMLDocument)
　　　　　　↓
Function SelectPulldownMenu(objIE) As String
プルダウン選択後のURLをFunctionでSub GetPage(row, url)のプロシージャに
読み込むようにしました。（引数はdocumentではなく、objIEに変更）

Function getMaxPage(objDoc As HTMLDocument)
　　　　　　↓
Function getMaxPage(objIE)
こちらも引数をdocumentから、objIEに変更しました。

うまくいく場合は検索後のページ数が取得できて、
だめな場合はURLが初期ページのままで、ページ数は0のままです。

・ツリー全体表示


	【76785】Re:AutoFilterで３つ以上の絞り込み方法

kanabun - 15/3/11(水) 23:01 -


	引用なし

	パスワード

▼亜矢さん： >　これを３つの会社以外(黒猫、佐川、西濃）のものを絞りこむ方法 AutoFilterではないですが、AdvancedFilterで複雑な条件を指定できます。ただし、条件はシートに書き込みます。 (以下は AA,AB,AC 列に条件を書きこむものとします）　　 AA　　　　　 AB　　　　AC 1　会社名　　　会社名　　会社名 2　 <>*ヤマト*　 <>*佐川*　<>*西濃* 3 Sub advTest() 　　Dim rt As Range 　　Dim rc As Range 　　Set rt = Range("A5").CurrentRegion 　　Set rc = Range("AA1").Resize(2, 3)　 'AA列以降に条件を書きこむ　　　rc.Rows(1).Formula = "=$A$5" 'A列タイトル「会社名」　　　rc(2, 1).Formula = "<>*ヤマト*" 　　　rc(2, 2).Formula = "<>*佐川*" 　　　rc(2, 3).Formula = "<>*西濃*" 　　　　rt.AdvancedFilter xlFilterInPlace, rc End Sub これなら条件がいくつでも可能です。

・ツリー全体表示


	【76784】Re:AutoFilterで３つ以上の絞り込み方法

β - 15/3/11(水) 22:05 -


	引用なし

	パスワード

▼マナさん：

わぁわぁ、逆転の発想ですね。
これ、いいかもですね。
今度、同様の質問がどこかであったら、しらっとして、βの回答としてアップするかも？
いえいえ、そんなことはしませんよ。
そういう機会があれば、「マナさんのアイデアです」と明記します。

・ツリー全体表示


	【76783】Re:AutoFilterで３つ以上の絞り込み方法

マナ - 15/3/11(水) 21:52 -


	引用なし

	パスワード

無駄なことしているようなような気もしますが
除外したいもの除いた配列を作成してはいかがでしょうか。

Sub test()
　　Dim a
　　Dim d As Object
　　Dim v
　　Dim i As Long
　　
　　a = Array("田中", "土屋", "鈴木")
　　
　　Set d = CreateObject("scripting.dictionary")
　　
　　ActiveSheet.AutoFilterMode = False
　　v = Range("a1").CurrentRegion.Columns(1).Value
　　
　　For i = 1 To UBound(v)
　　　　d(v(i, 1)) = Empty
　　Next
　　
　　For i = 0 To UBound(a)
　　　　If d.exists(a(i)) Then d.Remove (a(i))
　　Next
　　
　　Range("a1").CurrentRegion.AutoFilter Field:=1, _
　　　　Criteria1:=d.keys, _
　　　　Operator:=xlFilterValues
　　
End Sub

・ツリー全体表示


	【76782】Re:AutoFilterで３つ以上の絞り込み方法

β - 15/3/11(水) 21:13 -


	引用なし

	パスワード

▼亜矢さん：

xlFilterValues　は、それこそ、いくつでも、抽出文字列を「配列で指定できます。
でも、「抽出する文字列」なんです。"<>なんとか" といった　「式」は指定できないんです。
いつか、xl2020 ぐらいのバージョンで、サポートされるかもしれませんが。
その時は、もしかしたら xlFilterFormulas なんてもので配列指定ができるようになるかも
しれませんね。

まぁ、今はできないということで。

・ツリー全体表示


	【76781】Re:AutoFilterで３つ以上の絞り込み方法

亜矢 - 15/3/11(水) 20:19 -


	引用なし

	パスワード

▼β さん：
>▼亜矢さん：
>
>手作業操作でできるなら基本的にマクロでできるでしょうね。
>手作業操作でできなければ（おそらくシートのUserInterface:=True付の保護を除き）
>マクロではできないでしょうね。
>
>リストの右側にＡ列と同じものをコピーした上で、その列も含めてオートフィルター設定。
>この列は非表示でかまいません。
>その列に対して
>.Range("A5").AutoFilter Field:=●, Criteria1:="<>*西濃*"
>
>こうしてやれば、目的は達成できると思いますが。
さっそくのご指導ありがとうございます。
他の所でArrayを使った例が載っていました。それは
ActiveSheet.Range("$A$1:$B$9").AutoFilter Field:=1, Criteria1:=Array("田中", "土屋", "鈴木"), Operator:=xlFilterValues
上の例は田中、土屋、鈴木ですが、これを田中や土屋や鈴木で無い場合の
検索はどの様に表記したらよいでしょうか。
よろしくお願いします。

・ツリー全体表示


	【76780】Re:AutoFilterで３つ以上の絞り込み方法

β - 15/3/11(水) 15:37 -


	引用なし

	パスワード

▼亜矢さん：

手作業操作でできるなら基本的にマクロでできるでしょうね。
手作業操作でできなければ（おそらくシートのUserInterface:=True付の保護を除き）
マクロではできないでしょうね。

リストの右側にＡ列と同じものをコピーした上で、その列も含めてオートフィルター設定。
この列は非表示でかまいません。
その列に対して
.Range("A5").AutoFilter Field:=●, Criteria1:="<>*西濃*"

こうしてやれば、目的は達成できると思いますが。

・ツリー全体表示


	【76779】AutoFilterで３つ以上の絞り込み方法

亜矢 - 15/3/11(水) 14:36 -


	引用なし

	パスワード

よろしくお願いします
現在は運輸会社２つの会社以外をAutoFilterで絞っています。
.Range("A5").AutoFilter Field:=1, Criteria1:="<>*黒猫*", Operator:=xlOr, Criteria2:="<>*佐川*"

　これを３つの会社以外(黒猫、佐川、西濃）のものを絞りこむ方法をArrayを使って行いたいと思います。
　旨くできません。方法を教えてください。

・ツリー全体表示


	【76778】Re:複数のエクセルファイルから条件に一...

M - 15/3/11(水) 13:54 -


	引用なし

	パスワード

▼β さん：

test2で確認したところ正常に動作しました。

非常に参考になり、問題も解決しました。ありがとうございます。

・ツリー全体表示


	【76777】Re:複数のエクセルファイルから条件に一...

β - 15/3/11(水) 10:27 -


	引用なし

	パスワード

▼M さん：

そちらの環境で、Test2ではどうなりますか？

・ツリー全体表示


	【76776】Re:複数のエクセルファイルから条件に一...

β - 15/3/11(水) 10:21 -


	引用なし

	パスワード

▼M さん：

こちらでフォルダ内のエクセルブックをCSVファイルにかえ、
コードも *.csv にかえて実行。
Test1、Test2　ともに正常に終了していますが？

不思議ですねぇ？

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

282 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free