[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『二次元配列→一行に?』(T19)
お世話になります。
セル範囲を二次元配列に入れて、これをセルの一行に出力することを
検討しています。
※最終的には、複数ブックのセル範囲をマクロブックの特定シートに
転記するので、複数行になります
テスト的にコードを作成しましたが、この部分をワークシート関数などで
もっと簡単なコードにできないものでしょうか?
(テストコード)
Sub test() Dim arr1(), arr2() arr1 = Range("A1:E3").Value
Dim r As Long, c As Long, cc As Long, re As Long, ce As Long re = UBound(arr1, 1) ce = UBound(arr1, 2) cc = 1 ReDim Preserve arr2(1 To 1, 1 To cc) For r = 1 To re For c = 1 To ce arr2(1, cc) = arr1(r, c) cc = cc + 1 ReDim Preserve arr2(1 To 1, 1 To cc) Next c Next r End Sub
よろしくお願いします。
< 使用 Excel:Excel2010、使用 OS:Windows10 >
Dim arr2(), c As Range, i As Long
With Range("A1:E3") ReDim arr2(.Count - 1) For Each c In .Cells arr2(i) = c.Value i = i + 1 Next End With End Sub
(ピンク) 2019/05/15(水) 16:44
Sub test3() Dim R As Range Dim ar() As Variant Dim i As Long
Set R = Range("A1:E3") ReDim ar(R.Count - 1) For i = 1 To R.Count ar(i - 1) = R(i).Value Next i End Sub
というか、この例だったら R をそのまま使えば良いように思うのですけどね?
(???) 2019/05/15(水) 16:49
'Sheets("Sheet1")のRange("A1:E3")を Sheets("Sheet2")の最上行に出力 testsub Sheets("Sheet1").Range("A1:E3"), Sheets("Sheet2") End Sub
Function testsub(arg1 As Range, arg2 As Worksheet)
Dim i as long,rw as long,c as range rw = arg2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row i = 1 For Each c In arg1 arg2.Cells(rw, i).Value = c.Value i = i + 1 Next c End Function
(mm) 2019/05/15(水) 17:07
>この部分をワークシート関数などで >もっと簡単なコードにできないものでしょうか?
簡単かどうかは個人差があると思うけど、
Sub test() Dim x As String, y As String, myArray With Range("A1:E3") x = Range("a1").Resize(, .Count).Address y = .Columns.Count myArray = Application.Index(.Value, Evaluate("index(roundup(column(" & x & ")/" & y & ",0),,)"), _ Evaluate("if(mod(column(" & x & ")," & y & ")=0," & y & ",mod(column(" & x & ")," & y & "))")) End With [a10].Resize(, UBound(myArray)).Value = myArray End Sub (seiya) 2019/05/15(水) 17:39
簡単に Sub test2() Dim i As Long, myArray With Range("A1:E3") ReDim myArray(1 To .Count) For i = 1 To .Count myArray(i) = .Item(i) Next End With [a10].Resize(, UBound(myArray)).Value = myArray End Sub (seiya) 2019/05/15(水) 17:48
いつかはこのような洗練されたコードが書けるようになりたいと思いました。
ただ、seiyaさんの最初のコードは「myArray」の内容そのものが、「test2」は
何故[a10]とするのかわからずお手上げ状態です。
「test2」だけでも解説いただけると嬉しいです…
([[20070212134849]]が理解できるレベルでないとムリでしょうか?)
(T19) 2019/05/16(木) 13:09
For Each文は、アクセスの順番が保証されていない、とネットで目に
したりしますが、今回の例では避けた方がいいのでしょうか?
(真偽がわからないので、参考にお尋ねするものです)
(T19) 2019/05/16(木) 13:52
test2は難しいことはしていません。 関数で に対応しただけです。
シート上の範囲をFor Each ループすると 列方向に進む事を利用したものです。 スマホからなので後ほど詳しく設明します。 (seiya) 2019/05/16(木) 14:06
test1 は >この部分をワークシート関数などで >もっと簡単なコードにできないものでしょうか? を、 関数等を使用して、一発で(ループ無しで)変換したい
と理解して、提示しただけですのでこの際無視してください。
test2はごく単純ループで配列に値を渡して最終的にどのような処理をするのか不明でしたので とりあえず10行目に出力しただけです。
Sub test2() Dim i As Long, myArray With Range("A1:E3") ReDim myArray(1 To .Count) '<--1D Arrayのサイズを指定 For i = 1 To .Count myArray(i) = .Item(i) '<--左上端から列方向・行方向の順にループしてセルの値を配列に格納 Next End With [a10].Resize(, UBound(myArray)).Value = myArray '<--出力 End Sub
RangeのItemプロパティは Item(RowIndex, ColumnIndex)と2つの引数(何れも元範囲の左上端からのIndex) を持ちますが第二引数が省略された場合は列方向・行方向の順に指定されたIndexになります。
すなわち
With Range("A1,X1") For i = 1 To 2 MsgBox .Item(i).Address Next End With これは A1, B1がループの対象になります。
どこか不明な点があれば質問してください。
ちなみに For Each ループに関してですが、
Dictionary objectの仮想配列にループをする場合で順序が確定せず、想定外の結果になる場合がある。
と言われる方がいますが、私自身はそのような経験をしたことが無いので無視しています。 (seiya) 2019/05/16(木) 15:31
For Each文に関しては、いろいろな見解があるようですが、実際に
トラブッた例はあまりないような印象です..(目にする範囲で)
みなさんのコードを参考に、フォルダ内の複数ブックから順にデータを
取得〜一括出力のコードに活かしたいと考えます。
ありがとうございました。
これからもよろしくお願いします…
(T19) 2019/05/16(木) 17:22
Sub test001()
Dim rngOld As Range: Set rngOld = Sheets(1).Range("A1:E3") Dim rngNew As Range: Set rngNew = Sheets(2).Range("1:1") Dim i As Long
For i = 1 To rngOld.CountLarge rngNew(i).Value = rngOld(i).Value Next End Sub
けど、いちいち、個々のセルを読んで、いちいち、個々のセルに書き込むより、
配列変数にデータを並べてから、一括でセルに書き込んだ方が処理が速いです。
あと、ループ内で何度もRedimするのも処理が遅くなりますので、
データ数だけ数えておいて、ループが終ってから、
ReDim Preserve arr2(1 To 1, 1 To cc)
と1回やると、いいと思いました。
あ、縦優先なのかな。。。^^;
(まっつわん) 2019/05/16(木) 18:02
Sub test()
Dim v As Variant Dim vv As Variant Dim r() As Variant Dim i As Long
'vv = WorksheetFunction.Transpose(Worksheets(1).Range("A1:E3").Cells) '横優先 vv = Worksheets(1).Range("A1:E3").Value '縦優先 ReDim r(1 To UBound(vv, 1) * UBound(vv, 2)) For Each v In vv i = i + 1 r(i) = v Next Worksheets(2).Range("A1").Resize(, UBound(r)).Value = r End Sub (まっつわん) 2019/05/16(木) 20:41
>ループ内で何度もRedimするのも処理が遅くなり・・データ数だけ >数えておいて、ループが終ってから・・1回やる
これは理解できるのですが、やり方(手段)がわからず教えていただいてよかったです。
ReDimと配列変数がらみでの報告です。
実作業では二次元配列に今回みなさんに教えていただいたコードを参考に各ブックのデータを
一行にして放り込んでいくコードにしたのですが、そのコードのReDimのところでエラーが出ました。
原因は、二次元配列では一次元目をReDimできない、ということをすっかり忘れていまして・・・
(これに気付くのにかなり時間を費やしましたが)
結局のところ、わざわざ一行にせず、データを普通に二次元配列に放り込んでいった後に
「Transpose」しました。(他に解決策を思いつきませんでしたので)
恥しいトホホな後日談でみなさんには申訳ないですが、私には示唆に富む回答をいただいたと考えています。
ありがとうございました。
これからもよろしくお願いします…
(T19) 2019/05/17(金) 09:27
最初に何をしたいのかを質問した方が良かったと思いますが? 各ブックの取り込み範囲が同一サイズなら、親一次元配列に各範囲を一次元配列に変換した配列を取り込んで (Jagged Array)最終的にIndex, Transpose 等できっちりした二次元配列が出来上がります。 (seiya) 2019/05/17(金) 09:55
>最初に何をしたいのかを質問した方が良かったと思いますが?
そうですね、最初に構想をキチンと説明しておくべきでした。
(以後気をつけるようにします)
ジャグ配列を理解するのは私にはちょっと(かなり?)ムズかしいようです。
(そもそも通常の?配列の理解すらアヤシイです…)
「Index」は配列の中の配列を取出すのに使うのでしょうか?
実作業をひとまず片づけてから、振り返りたいと思います。
これからもよろしくお願いします…
(T19) 2019/05/17(金) 11:33
>「Index」は配列の中の配列を取出すのに使うのでしょうか?
配列に対しての使用方法は色々ありますが、この場合要素数が同一の一次元配列からなるJagged Arrayを 2次元配列に変換できます。
例: Dim myArray ReDim myArray(1 To 3) myArray(1) = Array(1, 2, 3, 4) myArray(2) = Array("a", "b", "c", "d") myArray(3) = Array("=5+1", "=5+2", "=5+3", "=5+4") myArray = Application.Index(myArray, 0, 0) [a1].Resize(UBound(myArray, 1), UBound(myArray, 2)) = myArray
(seiya) 2019/05/17(金) 13:50
「myArray(1 To 3)」に対し「myArray = Application.Index(myArray, 0, 0)」と
しているところで???状態です。
Index(myArray, 0, 0)でないと機能しないのはわかりましたが、
「0,0」は何かの“おまじない”(失礼)なんでしょうか?
「0,0」と指定することで全体を指す、というルールなのでしょうか?
(トンチンカンな質問ですみません…)
(T19) 2019/05/17(金) 17:09
Index関数は配列の一部・全部を取り出せます。 二次元配列で 0,0 を指定した場合配列の全部を参照します。
Sub sample() Dim myArray ' A1:C3にサンプルデータ生成 Range("a1:c3").Value = [{1,2,3;"a","b","c";"あ","い","う"}] '配列に格納 myArray = Range("a1:c3").Value myArray = Application.Index(myArray, 0, 0) Range("f1").Resize(UBound(myArray, 1), UBound(myArray, 2)).Value = myArray End Sub
前出のようにJagged Arrayに 0,0 を指定すると2次元配列に変換されます。 Index関数の内部動作についての疑問はマイクロソフトに聞いてください。 (seiya) 2019/05/17(金) 17:34
ん?結局、行列を入れ替えるだけでよかったんですか?
そうなら、
配列に放り込んでから、Transpose関数を使うと、
要素数の制限の縛りがあるので、
セル範囲で渡した方がよいかもしれません。
例だけみると、そんな広い範囲でもなさそうなので、要素数や処理速度の問題になることはないかと
思いますが、ワークシートで使う関数は、基本セル範囲を渡す仕様なので、
あえて値だけにしなくてもよいかと思いました。
もちろん、配列を受け付ける関数もあるのではありますが。。。
あと、出来れば一応の解決としたコードも提示していただけると、
こちらも、勉強になるのですが、、、、
(まっつわん) 2019/05/17(金) 22:08
>二次元配列で 0,0 を指定した場合配列の全部を参照
覚えておきます。
ジャグ配列やEvaluateメソッド、Itemプロパティについては、
時間かけて学習したく思います。
>配列に放り込んでから、Transpose関数を使うと、要素数の制限の縛りがあるので、 >セル範囲で渡した方がよい
制限のことは知りませんでした。(今回は問題ありませんが)
配列に入れたのは、複数ブックからデータを取込んだ後にいろいろな計算処理を
マクロでさせるためですが、取込みだけマクロでして一旦結果を出力〜それを
ワークシート関数で計算させる、というのもありかと今は考えています。
(時間とれずに未だ手つかずの状態です)
現在のコードを確認できる環境になく提示はできませんが、下記の流れになっています。
Dir関数を使ってループで各ブックを取得 →各ブックのデータを二次元配列に取込み →
ループを出た後にTransepose →(種々の計算処理〜一括結果出力)※この部分手つかず
これからもよろしくお願いします…
(T19) 2019/05/19(日) 09:57
追加の質問よろしいでしょうか?
「wbk.Close (False)」は「wbk.Close False」と意味合いが異なるのでしょうか?
(ネットで両方みかけましたもので..)
その他“こうすればいい”というアドバイスいただけると嬉しいです…
Sub test() '(画面更新「OFF」など・・・) Dim sh As Worksheet Dim re As Long '最大行(sh) Set sh = ThisWorkbook.Worksheets("test") With sh '(出力先消去など・・・) Const Path As String = "C:\Users\User001\Desktop\test\test\" Dim buf As String Dim wbk As Workbook Dim wsh As Worksheet Dim re2 As Long '最大行(wsh) Dim ar() Dim rng As Range Dim i As Long, clm As Long Dim cnt As Long: cnt = 0 buf = Dir(Path & "*.csv") Do While buf <> "" 'フォルダ内をループ Set wbk = Workbooks.Open(Path & buf) '対象ブック Set wsh = wbk.Worksheets(1) cnt = cnt + 1 re2 = 3 'test Set rng = wsh.Range(wsh.Cells(2, "A"), wsh.Cells(re2, "E")) 'test clm = rng.Count ReDim Preserve ar(1 To clm, 1 To 100) For i = 1 To clm ar(i, cnt) = rng(i).Value Next i wbk.Close (False) '保存しないで閉じる ★()不要? ⇒確認 buf = Dir() Loop ReDim Preserve ar(1 To clm, 1 To cnt) '余分を削除 ar = WorksheetFunction.Transpose(ar) '反転 .Range("A2").Resize(UBound(ar, 1), UBound(ar, 2)).Value = ar '出力 End With '(画面更新「ON」など・・・) End Sub (T19) 2019/05/20(月) 09:37
オブジェクトのメソッドを呼び出すので正式には Call wbk.Close(False)
オブジェクトはメソッドだらけなので、Callなんて書いていられないので 省略形を使うのが常態、 wbk.Close False
上の二つと似て非なるもの(まやかし書式) wbk.Close (False) ↑ カッコの前にスペースがあるのに留意(Callで使われるカッコとは別もの)
Falseを渡すのに、わざわざ不要なカッコを付けて引数を渡している。
数式なら、 =A1+1 でいいところ =A1+(1) と書いているようなもの
(半平太) 2019/05/20(月) 11:12
Callを省略する場合は引数を括弧()で囲まない、のルールからすると確かにこの場合は
括弧()は不要と納得できますが・・
(エラーにならないのも、=A1+(1)と同じ理由?)
Callできるのは Sub, Functionだけではないのでしょうか?
プロシージャやメソッドとは何ぞや?、がわかってないとダメっぽいですね。
そこらのコードを切り貼りしている身には、理解まで遠そうです…
もう少し勉強してから不明なところは別トピでアップさせていただきます。
(少々脱線気味のようでもありますし…)
(T19) 2019/05/20(月) 13:52
With sh
としているが、結局shを使っているのは、
.Range("A2").Resize(UBound(ar, 1), UBound(ar, 2)).Value = ar '出力
この行だけ?
Withを使っている意味があるのかな?
sh.Range("A2").Resize(UBound(ar, 1), UBound(ar, 2)).Value = ar '出力
とした方が後で断然読みやすいと思います。
あと、個々にセルを読んだり書いたりしたら、処理速度が遅くなります。
dim v
v = wsh.Range(wsh.Cells(2, "A"), wsh.Cells(re2, "E")).Value
で、一括で配列変数として代入できますので、活用してください。
参考URL>>
https://excel-ubara.com/excelvba1/EXCELVBA414.html
あと、変数が多すぎて読むのに頭痛くなりそう^^;
なので、With句をもっと上手く使えるといいかもですね。
(この辺は個人の嗜好もあるので、どっちがいいとかは言えないですけど。)
こんな感じでいいのでは?
Sub test()
Const Path As String = "C:\Users\User001\Desktop\test\test\" Dim wshResult As Worksheet: Set wshResult = ThisWorkbook.Worksheets(1) Dim buf As String Dim rng As Range Dim rngResult As Range
buf = Dir(Path & "*.csv") Do While buf <> "" With wshResult Set rngResult = .Cells(.Rows.Count, 1).End(xlUp).Offset(1) End With
With Workbooks.Open(Path & buf) With .Sheets(1).Range("A1").CurrentRegion Set rng = Intersect(.Cells, .Offset(1)) End With 'rng.Copy 'rngResult.PasteSpecial Transpose:=True rngResult.Resize(rng.Columns.Count, rng.Rows.Count).Value _ = WorksheetFunction.Transpose(rng.Cells) .Close False End With
buf = Dir() Loop End Sub
形式を選択して貼り付けでも、行列の入れ替えは出来ます。
Transpose関数とどっちが速いか試してみてください。
※動作確認してません。上手く動かなかったらごめんなさいです。
(まっつわん) 2019/05/20(月) 21:55
>その他“こうすればいい”というアドバイスいただけると嬉しいです… 各ブックの対象シート名が事前に判明してるか否かでかなり変わります。 Sheets(1)でなければならないのなら、そのままでいいと思います。 (seiya) 2019/05/21(火) 12:39
[wsh1] 11 12 13 14 15 21 22 23 24 25 [wsh2] 31 32 33 34 35 41 42 43 44 45 [sh] 11 12 13 14 15 21 22 23 24 25 31 32 33 34 35 41 42 43 44 45
ご提示コードでは、[sh]は10行2列になりますよね?
(説明がヘタですみませんでした)
しかしながら、withやOffset,Resizeの書き方、Intersect(初見です)と勉強になりました。
尚、フォルダ内の各ブックは全てシート1枚のため「Sheets(1)」としました。
また、実際のセル範囲は各ブック共通ですが、範囲は不連続です。
私のtestコードではDo..Loopの中で、For..Nextで各ブックのセル範囲を取得しています。
ここが何だか冗長のように思っていますがどうでしょうか?
(T19) 2019/05/21(火) 14:47
> 各ブックの対象シート名が事前に判明してるか否かでかなり変わります。 これに付いては回答が無いですが? (seiya) 2019/05/21(火) 15:03
> 各ブックの対象シート名が事前に判明してるか否か
各ブックの対象シートは1枚で、シート名は事前に判明しています。
ブックは第三者からcsvで提供され、ブック名もシート名もその時々で変わります。
(T19) 2019/05/21(火) 15:45
CSVなら問題なしで、私ならcsvから直接読み込み
Sub test() Dim myDir As String, fn As String, a, x, y, temp Dim i As Long, ii As Long, n As Long, t As Long Const sRow = 2, eRow = 3, sCol = 1, eCol = 5 '<- 設定 myDir = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\" '< 要変更 ReDim a(1 To 100): ReDim temp(1 To (eRow - sRow + 1) * (eCol - sCol + 1)) fn = Dir(myDir & "*.csv") Do While fn <> "" n = n + 1: t = 0 x = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(myDir & fn).ReadAll, vbCrLf) For i = sRow - 1 To eRow - 1 y = Split(x(i), ",") For ii = sCol - 1 To eCol - 1 t = t + 1 temp(t) = y(ii) Next Next a(n) = temp fn = Dir Loop ReDim Preserve a(1 To n) Range("a2").Resize(n, UBound(temp)).Value = Application.Index(a, 0, 0) End Sub
(seiya) 2019/05/21(火) 16:20
一か所変更 16:26
・「csvから直接読込み」が「x=....」に相当?
・これにより「Index」が使用できるようになる?
・SFOは未経験
・・等々、すみません、理解までしばらく時間いただきます…
(かぎりなく自信ないですが (_ _) )
(T19) 2019/05/21(火) 17:26
・「x」で各ブックシートの全内容を格納
・For i で指定“行”範囲の内容を「y」に格納
・ For ii で指定“行列”範囲の内容を「temp」に格納
・「 a(n) = temp」で各ブック単位で格納
と、ここで思考停止しています…
ローカルウィンドで確認しますと、「a(1)」は「a(1)(1)...a(1)(10)」となっていますが、
この仕組み(?)がわかりません。
また、この配列(?)は何と呼ぶのでしょうか?(ジャグ配列でしょうか)
「Index」で「Transepose」みたいなことができる仕組みもよくわかりません。
わからないことばかりで恐縮ですが、噛み砕いていただけないでしょうか?
(T19) 2019/05/22(水) 10:56
その前に、そのコードで期待通りの結果は得られていますか?
それが分らないと、先へ進んでも意味が無いように思いますが? (seiya) 2019/05/22(水) 11:03
(T19) 2019/05/22(水) 11:44
「ReDim Preserve a(1 To n)」がないと「型不一致エラー」になるようですが、何故でしようか?
不要ではないかと思っていたもので…
(T19) 2019/05/22(水) 11:56
実際のCSVファイルを見ているわけではないので、作成されたPlatform によっては改行コードが変わります。 ですので、機能してるかどうかの確認は大事です。
理解しやすいように変数 txt を用意してCSVの文字列を読み込んでいます。 ステップディバッグして確認してください。 もし不明な点があるようでしたら再度質問してください。
Sub test() Dim myDir As String, fn As String, a, x, y, temp, txt As String Dim i As Long, ii As Long, n As Long, t As Long Const sRow = 2, eRow = 3, sCol = 1, eCol = 5 '<- 設定 myDir = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\" '< 要変更 '↓ 親1次元配列の暫定要素数と、各CVSのデータ格納用1次元配列の要素数の確定 ReDim a(1 To 100), temp(1 To (eRow - sRow + 1) * (eCol - sCol + 1)) fn = Dir(myDir & "*.csv") Do While fn <> "" n = n + 1: t = 0 txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(myDir & fn).ReadAll '<- txt に読み込み x = Split(txt, vbCrLf) '<- 読み込んだ文字列を改行コードで行に分割 For i = sRow - 1 To eRow - 1 '<- 設定開始行から設定最終行までループ y = Split(x(i), ",") '<- 行データを区切り文字で分割 For ii = sCol - 1 To eCol - 1 '<-設定開始列から設定最終列までループ t = t + 1 temp(t) = y(ii) '<- 該当行・列データを1次元配列に格納 Next Next a(n) = temp '<- 親1次元配列にtempを格納 (Jagged Array) fn = Dir Loop ReDim Preserve a(1 To n) '<- 親配列の最終要素数の確定 a = Application.Index(a, 0, 0) '<-2次元配列に変換 'a = Application.Transpose(Application.Transpose(a)) '<- 同様に2次元配列に変換 Range("a2").Resize(n, UBound(temp)).Value = a '<- 出力 End Sub
>「ReDim Preserve a(1 To n)」がないと「型不一致エラー」になるようですが、何故でしようか? 前述したように、要素数が同一の一次元配列で構成された一次元配列(Jagged Array)の場合 Index 及び Transpose メソッドで2次元配列に変換できます。 その一行が無いと、nより大きい要素は Empty で配列ではありませんのでエラーになります。
これから出かけますので、返信は戻ってからになります。 (seiya) 2019/05/22(水) 12:22
>要素数が同一の一次元配列で構成された一次元配列(Jagged Array)の場合 Index 及び Transpose メソッドで2次元配列に変換できます
⇒これはもう、そうなるものだと覚え込みます
>その一行が無いと、nより大きい要素は・・・エラーになります
⇒例えばフォルダ内の対象ブックが4個の場合、ループを抜けた後は「n=4」ですよね?
「nより大き」くなることってあるのでしょうか?
(ピント外れだとは思いますがお許しください…)
(T19) 2019/05/22(水) 14:50
Redim a(1 To 100) で予め余裕を持った添字数を確保しています。
(seiya) 2019/05/22(水) 15:43
その他消化不良のところは、[[20090724125126]]などを参考に鍛え直します。
(行き詰まった時は別途アップさせていただきます)
FSOがらみでASCII,Unicodeや文字コードを調べられてよかったです。
みなさんに提示されたコードを拝見して、いろいろと記述のしかたで勉強になりました。
こういうのを当たり前のように書けるようにしたいと思います。
ありがとうございました。 これからもよろしくお願いします。
(T19) 2019/05/22(水) 17:40
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.