[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『AutoFilterの結果を配列へ』（やっぱり初歩）
いつもご指導頂き有難うございます。
AutoFilterに関する質問は２つです。
・主題の通りフィルターした結果を配列にする方法
(1)先頭行から配列へ (2)先頭行を除いて配列へ
何れの場合も For 〜 Next で処理するより簡単でしょうか？
自分なりに試行しましたが良く分かりません。
シート上ではフィルターされ不要な行などは見えていませんが、そのアドレスは
変わってないのでどうしていいのか先に進みません。
・過去ログにあった記述から質問
xxx=Intersect(ActiveSheet.AutoFilter.Range,ActiveSheet.AutoFilter.Range.Offset(1))
この場合のIntersectの役割は何でしょうか？ データ範囲のクロスではない様に思うのですが…
解らない事ばかりで半日を過ごしました。 どうぞ宜しくお願いします。
＜ 使用 Excel：Excel2010、使用 OS：Windows8 ＞
もちろんループで行のHiddenプロパティを調べながら True のものを配列に取り込む方法がありますが オートフィルター領域をコピペすると、抽出部分（表示されている部分）のみのコピペとなる性質を利用したほうが 簡単かもしれません。
以下は、Sheet1 にオートフィルターが設定されていて、その抽出部分のみを タイトル行も含めて配列 w1 に、 タイトル行を除いたものを 配列 w2 に取り込む例です。
コピペ作業用に Sheet2 を 利用するとともに、取り込んだ配列の中身の検証として、その中のイメージを Sheet2 に転記しています。
このなかで質問の Intersect もでてきます。
シート.AutoFilter.Range とは そのオートフィルターがセットされたタイトル行を含むリスト領域です。
仮に、それが A1:E20 だったとします。
シート.AutoFilter.Range.Offset(1) は、領域を１行下にずらしたものです。 ですから A1:E21 になります。
タイトル行を除いたデータ部分は A2:E20 ですね。
A1:E20 と A2:E21 を Intersect すると、その重なった部分が取得されます。 つまり、A2:E20 です。これがデータ領域ですね。
で、コメントしたように、フィルターがかかった領域をコピペすると、表示されている部分だけがコピペされます。
Sub Test1()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim r As Range
Dim w1 As Variant
Dim w2 As Variant
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
With sh1.AutoFilter.Range
If .Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then Exit Sub '抽出なし
sh2.Cells.ClearContents
.Copy sh2.Range("A1")
w1 = sh2.Range("A1").CurrentRegion.Value
sh2.Cells.ClearContents
Intersect(.Cells, .Offset(1)).Copy sh2.Range("A1")
w2 = sh2.Range("A1").CurrentRegion.Value
End With
'検証
sh2.Cells.ClearContents
sh2.Range("A1").Resize(UBound(w1, 1), UBound(w1, 2)).Value = w1
sh2.Range("A1").Offset(UBound(w1, 1) + 1).Resize(UBound(w2, 1), UBound(w2, 2)).Value = w2
End Sub
（β） 2015/10/15(木) 21:56
↑ コピペ作業を簡単にするために作業用シートとして別シートを使いましたが、もちろん同じシートの 未使用領域を作業用として使うことはできます。
（β） 2015/10/15(木) 22:05
早速試行させて頂きました。『 Intersect 』については納得できました。到りませんでした 有難うございました。
本件では半日掛けて瞑想していました。ＭＳサイトを調べたり、過去ログを調べたりしました。 自分なりに理解した事は、フィルターした物を別の場所へ一旦コピーして後に配列格納する。 この様な方法しかないのかと思っていました。
どのかの過去ログかで、『記述は長く泥臭くても、処理速度はさほど影響ない』とありました。 勿論状況にもよりますが、その事は承知の上で今回の質問をしました。
Excel本体のコマンド群、例えばSortは下手に自作するより処理速度は圧倒的に早い事でそれらを 利用すべきかと考えた次第です。 装備されている物を利用すべきかと素人には思えたのです。 ※結論を出す迄は何かないかとプロパティーを探ったりしましたが結果が出ませんでした。
若しCopy&Past 無しで一気に配列へデータを格納する方法があれば利用価値があるかなと思います。 その事は、隠れた第二の副題『 For〜Next ＋ If文 』との速度等の比較に対する疑問です。
言葉ばかりで申し訳ありません。出来ましたらご意見をお願いします。
（やっぱり初歩） 2015/10/15(木) 22:59
まず、エクセルに備わった標準機能は、きわめて効率がいいというのは事実です。 これは、もちろん、それを実行する実装が、我々素人が書くコードと比較して、処理品質が雲泥の差ということはあると思いますが 加えて、内部処理専用の効率の良いメモリー域が用意されていると思われますし、また、たとえばセルの物理的な実装レベルでの構造を前提に 処理しているところもあるんだと思われます。（ここは、我々は手が出せず、あくまで公開されたプロパティを相手にするしかないわけです）
で、その標準機能に【コピペ】があります。 大きなセル領域を転記するとき、転記先.Value = 転記元.Value あるいは 転記先.Value = 転記用配列 より 転記元.Copy 転記先の最初のセル としたほうが、処理スピードが速いという事実があります。
ですから、Sort を自作するより、標準機能の Sortメソッドなり Sortオブジェクトを相手にした Applyメソッドが優れているのと同様 領域 --> 配列 --> 別領域 というコードをシコシコ書くより コピペが優れているということです。
さらに、残念ながら、フィルターで抽出されたものだけを一気に配列に格納することは仕様上、不可能です。 これをやるなら、我々の「自作コード」で、シコシコ配列に取り込むことが必要になります。
したがって、処理効率は劣ることになりますがご希望でしたら、コード案をアップしますが？
（β） 2015/10/15(木) 23:34
↑
>>残念ながら、フィルターで抽出されたものだけを一気に配列に格納することは仕様上、不可能です
こう書きましたが、もしかしたら クリップボード経由で処理すればできるかもしれません。 やったことはないのですが。
（β） 2015/10/15(木) 23:39
>クリップボード経由で処理すればできるかもしれません。 この様な事は理解できませんが、以前から 転記先.Value = 転記元.Value の方法は利用してきました。 同時に Variant変数 = 転記元.Value などもしていますが、以前からこの事は『コピペ』なのか又は、 『データ転送』しているのか疑問でした。やはり、これは『コピペ』だったんですね。
納得出来る事ばかりでした。色々ご指導いただき有難うございました。
（やっぱり初歩） 2015/10/15(木) 23:55
もう、ご覧にならないかもしれませんが
>> 同時に Variant変数 = 転記元.Value などもしていますが、以前からこの事は『コピペ』なのか又は、 >>『データ転送』しているのか疑問でした。やはり、これは『コピペ』だったんですね。
いえいえ。これはコピペではなく データ転送（転記）です。 コピペは、あくまで コピー元 --> クリップボード --> コピー先 という動きになります。 転記先.Value = 転記元.Value や Variant変数 = 転記元.Value あるいは 転記先.Value = Variant変数 は クリップボードを使っていません。
で、クリップボードに抽出結果の領域をコピーして、そこから直接そのデータを取得して、改行やタブ等を加味しながら 配列に落とし込むコードを書いてみましたが、これは（処理スピードはどうかわかりませんけど）結局は イメージをループで回しながら配列に無理やり格納するといった感じになりますね。 これをやるなら、オートフィルター領域をループで回して、表示行を配列に取り込むほうが、ずっとシンプルでした。
（β） 2015/10/16(金) 00:25
深夜までお付き合い頂き有難うございます。今朝になり今一度確認していたところ少々気になる事が出てきました。
＞これをやるなら、オートフィルター領域をループで回して、表示行を配列に取り込むほうが、ずっとシンプルでした。
此れの意味するところはβさんの最初ご提案『ループで行のHiddenプロパティを調べながら True のものを配列に取り込む方法』なのか Test1プロシージャを指すのか、又は、他の方法を言われているのか分からなかったのです。
これだけが頭の中で？？？となりました。もし他の方法であって私でも理解できるようなコードならコードアップして頂けたら幸いです。
（やっぱり初歩） 2015/10/16(金) 09:07
書いてみたのは、コピペ ベースですが、作業シートを経由せずメモリー内で配列化するものです。 以下に参考まで、アップしますが、これなら、素直に、領域の各行を調べながら配列に格納するほうが シンプルかつわかりやすいと思った次第です。
以下のコード、ダミーでユーザーフォームを挿入して、開放するか、Microsoft Forms x.x Object Library に参照設定をするか いずれかが必要になります。
処理本体は、GetFilterdArea で、実行サンプルとして Test。オートフィルター領域を２次元配列に取り込んでいます。 確認のため、生成した配列イメージをオートフィルターリスト領域の下に転記しています。
Sub Test()
Dim z As Long
Dim w1 As Variant
Dim w2 As Variant
With ActiveSheet.AutoFilter.Range
w1 = GetFilterdArea(.Cells)
w2 = GetFilterdArea(Intersect(.Cells, .Offset(1)))
z = Range("A1", .Cells).Rows.Count + 2
End With
Cells(z, "A").Resize(UBound(w1, 1), UBound(w1, 2)).Value = w1
Cells(z + UBound(w1, 1) + 1, "A").Resize(UBound(w2, 1), UBound(w2, 2)).Value = w2
End Sub
Function GetFilterdArea(r As Range) As Variant
Dim w As Variant
Dim tmp As Variant
Dim v As Variant
Dim Dobj As New DataObject
Dim x As Long
Dim y As Long
Dim i As Long
Dim j As Long
r.Copy
With Dobj
.GetFromClipboard 'クリップボードからDataObjectにデータを取得
tmp = .GetText 'そのデータを取り込み
tmp = Split(Left(tmp, Len(tmp) - 2), vbCrLf) '末尾の改行を削除
y = UBound(tmp) '行数(-1)
For i = 0 To UBound(tmp)
w = Split(tmp(i), vbTab)
If i = 0 Then
x = UBound(w) '列数(-1)
ReDim v(1 To y + 1, 1 To x + 1)
End If
For j = 0 To UBound(w)
v(i + 1, j + 1) = w(j)
Next
Next
End With
Application.CutCopyMode = False
GetFilterdArea = v
End Function
（β） 2015/10/16(金) 11:47
> ・主題の通りフィルターした結果を配列にする方法 > (1)先頭行から配列へ (2)先頭行を除いて配列へ
Sheet1からSheet2へ
Sub test()
Dim a, x(), txt, e, s, n As Long, flg, rng As Range
flg = Application.InputBox("Headerを含む?" & vbLf & "1 For True,0 For False", Type:=1)
If flg = "False" Then Exit Sub
With Sheets("sheet1").Cells(1).CurrentRegion
With .Offset(IIf(flg, 0, 1)).Resize(.Rows.Count - IIf(flg, 0, 1))
On Error Resume Next
Set rng = .Columns(1).SpecialCells(12)
On Error GoTo 0
If Not rng Is Nothing Then
txt = Replace(rng.Address(0, 0), "A", "")
For Each e In Split(txt, ",")
For Each s In Split(e, ":")
n = n + 1
ReDim Preserve x(1 To n): x(n) = s
Next
Next
End If
End With
If Not rng Is Nothing Then
a = Application.Index(.Value, Application.Transpose(x), _
Evaluate("column(" & .Address & ")"))
End If
End With
If n = 0 Then
MsgBox "No data"
ElseIf n = 1 Then
Sheets("sheet2").Cells(1).Resize(, UBound(a)).Value = a
Else
Sheets("sheet2").Cells(1).Resize(n, UBound(a, 2)).Value = a
End If
End Sub
（seiya） 2015/10/16(金) 12:44
修正:フィルタで何も抽出できていない場合のエラー処理の追加 2015/10/16(金) 16:50
どうもどうもです。この件を自分のブックに取込む作業をしていたので遅れました。 昨日まで教えて頂いたものは概ね自分流に出来るようになりました。然し、すぐ忘れるかも・・・
アップして頂いたコードは取敢えずコピーして勉強します。明日は所用でいないので進捗状況報告は 来週になります。 今は頭の中の余裕は殆どないのですが、知らないオブジェクトが出てるので理解に時間が掛かると思います。 少しだけ 11:47 のコードを見て思った事はフィルターした所から事前にコピーをする事でしょうね。
どれが速い処理速か確認できればとは思いますが、それよりも素人の私には様々な方法を知る事の方が 一番楽しいのです。つまり私の最も興味を引くところだからです。
seiyaさんへ
見たばかりでよく分かりません勉強します。 頑張ります。
（やっぱり初歩） 2015/10/16(金) 14:58
アップ済みのコード、配列作成の部分でのループ処理をなくしてみました。 GetFilterdArea を 入れ替えです。
Function GetFilterdArea(r As Range) As Variant
Dim tmp As Variant
Dim Dobj As New DataObject
r.Copy
With Dobj
.GetFromClipboard 'クリップボードからDataObjectにデータを取得
tmp = .GetText 'そのデータを取り込み
End With
Application.CutCopyMode = False
With CreateObject("VBScript.RegExp")
.Pattern = "([^" & vbTab & vbCrLf & "]+)"
.Global = True
GetFilterdArea = Evaluate("{" & Replace(Replace(.Replace(Left(tmp, Len(tmp) - 2), """$1"""), vbTab, ","), vbCrLf, ";") & "}")
End With
End Function
（β） 2015/10/16(金) 19:46
βさんへ 少し時間が空きましたがプロシージャ内の流れは理解出来、有難う御座いました。 只、知識の浅い私には分からない事がありました。
Function GetFilterdArea 内で次の行の意味を教えて下さい。
tmp = Split(Left(tmp, Len(tmp) - 2), vbCrLf) 'vbCrLf で区切る
w = Split(tmp(i), vbTab) 'vbTab で区切る
[質問-１] vbCrLf や vbTab の区切り文字（制御コード）とは何なんでしょうか、又、その役割は何ですか？
10/22 13:59 の
With CreateObject("VBScript.RegExp")
.Pattern = "([^" & vbTab & vbCrLf & "]+)"
.Global = True
GetFilterdArea = Evaluate("{" & Replace(Replace(.Replace(Left(tmp, Len(tmp) - 2), """$1"""), vbTab, ","), vbCrLf, ";") & "}")
End With
CreateObject("VBScript.RegExp") が全く分かりません。
.Pattern = "([^" & vbTab & vbCrLf & "]+)" 各種記号の意味が分からず。
更には Evaluate から始まり直ぐに "{" が出てきて？ 意味分からずです。Evaluate はあまり好きではないです…
■私の今回の質問させて頂いた本質は、コンボボックスへデータリストから特定列に複数ある値（重複）を 無くしてそのレコードの連続したフィールドをコンボへ表示させたい事でした。 以下の様な方法で出来ないかと模索したのですが、コンボに表示されるのは真っ白です。 ローカルウィンドでは dic(0)(1) 等と表示され？でした。その為諦めてAutoFilterをトライしたのです。
Sub myTest()
Dim Ar(1 To 6), tbl, 条件
tbl = Range("A2").CurrentRegion.Value
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tbl)
条件 = xxx
If 条件 = tbl(i, 3) Then
For k = 1 To 6 '１レコード分（６列）
Ar(k) = tbl(i, k)
Next
dic(tbl(i, 1)) = Ar()
End If
Next
Combo.List = dic.Items
End Sub
[質問-２] CreateObjectを使っての方法でも出来るのでしょうか [質問-３] CreateObjectの利用の場合、Microsoft Scripting Runtime の参照設定が必要なんでしょうか
度重なってお聞きして恐縮ですがよろしくお願いします。 （やっぱり初歩） 2015/10/22(木) 14:21
エクセルのみではないのですが、プログラムの世界で、"A" や "あ" や 1 といった 「普通」の文字の他に 目に見えないけど、その文字列をコントロールするための「制御文字」というものがあります。
「制御文字」や「エクセル 制御文字」で検索して、わかりやすそうなページも参考にしてもらいたいのですが たとえばA1に ABC とタイプし Alt/Enter、続けて XYZ でEnter。
こうすると、ABC と XYZ がセル内で（連続した文字列なのに）２行になりますね。 これは、ABC と XYZ の間に、目には見えませんが、改行コード(エクセル仕様としては vbLf)が挟みこまれているんです。
別のセルに =LEN(A1) と打ち込むと 6ではなく7になるはずです。ABC の3文字とXYZの3文字と、もう１桁何か文字があるわけです。
で、改行について、エクセルは、Microsoftの中でも、ちょっと【継子】で、Windows一般では 改行コードは vbCrLf です。 これは vbCr(キャリッジリーターン)とvbLf(ラインフィード)があわさった２桁の文字です。
で、セルの領域をクリップボードにコピペすると、セル領域の１行の最後に、この vbCrLf が付加されています。
vbTab も制御文字の一種で、これは、エクセル操作上は、作り出すことが困難ですが、システムが、様々な局面で使っています。 たとえば エクセルブックを名前を付けて保存、この時、ファイルの種類で、テキスト(タブ区切り)(*.txt) というのを目にしたことがあるかと思います。 セル領域の中のセルと次のセルの間に、この vbTab が挟みこまれます。 セル領域をクリップボードにコピペした時、同じようにセルとセルの間に vbTab が挿入されます。
具体例でいうと
ABC DEF GHI JKL MNO PQR
こんなセル領域だったとして、これを単に連続させて ABCDEFGHIJKLMNOPQ にすると、元々がどんな形だったかがわからなくなりますね。
なので、クリップボード内では
ABC○DEF○GHI●JKL○MNO○PQR● という文字列になっています。ここで ○が１桁の vbTab、●が2桁のvbCrLfです。
Function GetFilterdArea 内で次の行の意味を教えて下さい。
回答の順序をあえて、逆にしました。
まず Split関数は、配列用変数 = Split(文字列,区切り文字) と書きます。文字列を指定の区切り文字で区切って、１次元配列というものに格納します。 たとえば おはよう、こんにちは、さようなら という文字列を "、" でSplitすると ３つの要素を持った配列にそれぞれが格納されます。 この時、要素番号は0から始まっているので 配列(0) が おはよう 配列(1)が こんにちは 配列(2) が さようなら と格納されます。
で、tmp = Split(Left(tmp, Len(tmp) - 2), vbCrLf) は ABC○DEF○GHI●JKL○MNO○PQR● という文字列を Left(tmp, Len(tmp) - 2) で最後の２桁をカットしたものを ● で区切りますので、できあがった tmp という配列は tmp(0) が ABC○DEF○GHI 、tmp(1)が JKL○MNO○PQR になっています。 この配列の要素それｚそれを w = Split(tmp(i), vbTab) つまり tmp(0) なら ABC○DEF○GHI を ○で区切り w という配列に格納しますので w(0) ABC w(1) DEF w(2) GHI もともとのセルにわかれた状態にして把握できるということになります。
CreateObject("VBScript.RegExp") が全く分かりません。
そうかもしれませんねぇ。正規表現 という優れもののプログラム機能です。 正規表現という言葉自体は、なんだかおかしく感じられるかもしれませんが。（違法表現とかもぐり表現の反対語というわけではありませんので。）
私も、見よう見まねで、使っているレベルですが、この機能に様々なパターンを与えることで、文章の中から、いろんな文字列を抜き出したり あるいは変換したり、そういうことが、たとえば エクセルでいう Like 比較で使うパターンと比べると、生まれたての赤ちゃんと大学生ぐらいの パワーの差があります。
[質問-２] CreateObjectを使っての方法でも出来るのでしょうか
[質問-３] CreateObjectの利用の場合、Microsoft Scripting Runtime の参照設定が必要なんでしょうか
ここでいう CreateObject とは CreateObject("Scripting.Dictionary") のことでしょうか？
で、アップされた、そちらのコードの構成でなんとか処理できないかということでしょうか？
まず、CreateObject は、ＶＢＡ以外のプログラム機能を使いたいときに CreateObject(その機能のクラス名)と記述するものです。
で、CreateObject("Scripting.Dictionary") は、今から、Dictionary の機能を使いたいのでプログラムを呼んでくださいという命令です。
この場合、参照設定は不要です。（参照設定してもいいのですが）
このテーマ、そのものが、結構、ややこしいものですので、必要なら、理解をお手伝いするコメントも書きますが、まずは 「実行時バインディング 事前バインディング」あたりで検索して、わかりやすそうなページに目を通してみてください。
で、このコードですが、tbl に取り込んだCurrentRegionの大きさ（列数）や、その内容が不明なんですが、今からちょっと 見てみます。（基本的には、DIctionaryで重複を削除して取り込むことは、もちろんできますので）
（β） 2015/10/22(木) 16:44
コード拝見
うまくいかなかった原因は DictionaryのItemが１次元配列になっているからです。 DictionaryのItemsメソッドで取り出したものは１次元配列ですけど、問題は その１次元配列内の各要素も dic(tbl(i, 1)) = Ar() つまり１次元配列になっているところです。
１次元配列の要素も１次元配列というデータをコンボボックスなどに登録する２次元配列に変換するには
Combo.List = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.Items))
または
Combo.Column() = WorksheetFunction.Transpose(dic.Items)
いずれかで試してみてください。
（β） 2015/10/22(木) 18:39
というような拡大解釈をした場合、 ADO（データベースを扱うツールオブジェクト）を使うと配列化は、これが行ってくれます。
ADOは、アクセス等のデータベースで扱うオブジェクトですが、Excelやテキストファイルでも扱えます。
検索対象Excelブックを開いた状態でも閉じた状態でも使用可能です。 検索には、Sqlが必要ですが、簡単な検索に使うSQLなら、簡単です（当たり前か）。
上記は、テキストファイルを使った例ですが、コネクションストリングをExcel用に代えれば、 似たようなことは、Excelでも出来ます（Excelの場合、schema.iniは、要らない）。
この際、検索結果は、Recoedsetオブジェクトで扱うのですが、このオブジェクトのGetRowsメソッドが 検索結果を配列で返す機能です。
本題とは、ずれますが、検討投稿です。
（ichinose） 2015/10/23(金) 07:06
返事が遅くなりすみませんでした。 昨晩はボランティアの仲間と打合せ（酒を飲み乍ら）で何もしていませんでした。今もまだ酒が残っています… 今朝起きて次の２行の件を理解しようとしました。
◆改行コードを削除(-2 した物)に対し、vbCrLf で区切る
tmp = Split(Left(tmp, Len(tmp) - 2), vbCrLf)
tmpの各要素をvbTab で区切る
w = Split(tmp(i), vbTab)
半分分かったような分からないような感じです。既にあるvbCrLfやvbTabをもう一度同じ文字制御で区切りのか？
理解力が乏しいので良く考えてみます。
◆Scripting.Dictionaryで得たItemsを教示して頂いた下記コードで旨く行きました。
Combo.Column() = WorksheetFunction.Transpose(dic.Items)
記憶の中ではこのTransposeも脈絡もなく使った事もあったのですが、何か間違えたのか不成功でした。 頭の中を整理してみると、配列の１次元配列となっている各レコードを２次元配列へ変換できる事を再確認しました。 そのまま使っていたのでデータ件数は合っていましたが選択項目が真っ白だった理由が分かりました。
＞[質問-３] ＣｒｅａｔＯｂｊｅｃｔ の利用の場合、Microsoft Scripting Runtime の参照設定が必要なんでしょうか この事はご指摘の様に Scripting.Dictionary を指していました。 FSO等の時に参照設定が必要なようにこの場合も設定が必要か否か良く分かりませんでした。 何となくFSOでは、ファイル操作上でエクセルには無い機能を参照する為に必要だからだと思っていましたが、 Scripting.Dictionary では必要ないと推測していたのが、何処かでこの場合も参照設定が要ると書かれてた 様に思ったので質問させて頂きました。
私の問題は解決しました。有難うございました。 余談ですがβさんがとうに還暦を越されていたなんて思いもしませんでした。私も４年前に迎えました。 PCは長く使っていましたが仕事上では殆ど使わず、全く縁のない営業職のため自宅で趣味の範囲で やってきました。そんな中でβさんの温かさを感じる返答を見ながらも多分５０代の人だろうと想像。 博学で優しい人だなとイメージしていました。 有難うございました。
ichinoseさん
以前は少しＡＤＯを使いましたが書く事自体が面倒で全く使っていません。 使わないかもしれませんが今一度勉強しようと思いました。
（やっぱり初歩） 2015/10/23(金) 07:55
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.