[[20161231004826]]　『縦5267行１列のデータをマクロで一覧表形式に整形』（ｉｂｏｉｂｏ）　ページの最後に飛ぶ

『縦5267行１列のデータをマクロで一覧表形式に整形したい』（ｉｂｏｉｂｏ）

バイナリーオプションの時間別判定表です。

画面上では一覧表の表示となっていますが、ＣＳＶとかでダウンロードできず、判定表から「全て選択」でデータをコピーしてエクセルに貼り付けてデータを取得しています。
貼り付けたデータは縦に１列のデータとなります

１行目～１７行までは会社名などの不必要なデータです。

【データの形式】
１８行目から判定時間の「AM7:15、AM7:20等」の文字が２９１行目まで２７４回の５分毎の判定時間（最終翌日AM6:00）の縦項目があります。

２９２行～３０９行までは１８種類の「USD/JPY、EUR/USD等」の通貨名が表示されています。

３１０行～５２４１行までは、１８行づつ５分枚の通貨別判定額が５２４１行まで繰り返されます。

【貼り付けたデータのイメージ】シート名「読込」
Ａ列
AM7:15　１８行目
AM7:20
AM7:25
　・
　・
　・
AUD/JPY ２９２行目
AUD/USD
EUR/JP
　・
　・
　・
84.014 ３１０行目
0.71792
121.91
　・
　・
　・
ＦＸ会社判定表の画面表示は下記のイメージですが、貼り付けると縦１列のデータとなります。

【整形して作りたい一覧表のイメージ】ＦＸ会社判定表の画面表示

Ｄ列　　Ｅ列　　Ｆ列　　Ｇ列･･････
時間　　AUD/JPY AUD/USD EUR/JPY･･･････
AM7:15　84.014 0.71792 121.91････
AM7:20　84.024 0.71794 121.90････
AM7:20
AM7:25
AM7:30
AM7:35
最終行（翌AM6:00）

■判らないなりに自動マクロで作ってみて補正しました。

Ａ）下記のようなマクロを２６２行分作らなければならないのでしょうか
Ｂ）又、データはどのように蓄積していけばベストでしょうか

Sheets("読込").Range("A310:A327").Copy

    Sheets("読込").Range("E18").PasteSpecial _
    Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False

    Range("A328:A345").Select
    Selection.Copy

    Range("E19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True

    Range("A346:A363").Select
    Selection.Copy

    Range("E20").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True

    Range("A364:A381").Select
    Selection.Copy

    Range("E21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True

以下繰り返し

    End Sub、

＜使用 Excel：Excel2003、使用 OS：Windows7 ＞

 説明文はほどんど読んでいません。
 アップされた行列入れ替えの転記部分のみ。

 シートの関係もよくわからなかったので、アクティブシート前提です。

 Sub Sample()
    Dim i As Long
    Dim x As Long

    x = 18

    For i = 310 To Range("A" & Rows.Count).End(xlUp).Row Step 18

        Range("E" & x).Resize(, 18).Value = WorksheetFunction.Transpose(Range("A" & i).Resize(18))
        x = x + 1

    Next

 End Sub

（β） 2016/12/31(土) 07:53

 配列を利用した別方法を示してみます。
 magic number使い過ぎの感があるものの、一応参考程度にはなるかと。

 質問B)は、データがどのように変わりうるのかの情報が必要でしょう。
 時刻の刻みは固定なのか。貨幣は固定か。
 汎用的なのは、
 日付、時刻、通貨、価格
 という形式で保持しておいて、ピボットテーブルで表にするんでしょうか。

 参考コード

 Sub test()
     Dim v(1 To 5267)
     Dim mat(0 To 274, 0 To 18)

     Dim j As Long
     Dim k As Long

     'データをいったん配列に読み込む
     For k = 1 To 5267
         v(k) = Cells(k, 1).Value
     Next

     '観測時刻
     For k = 1 To 274
         mat(k, 0) = v(17 + k)
     Next

     '通貨名
     For k = 1 To 18
         mat(0, k) = v(291 + k)
     Next

     'データ
     For j = 1 To 274
         For k = 1 To 18
             mat(j, k) = v(309 + (j - 1) * 18 + k)
         Next
     Next

     'データの書込み
     Sheet2.Range("A1").Resize(UBound(mat, 1) + 1, UBound(mat, 2) + 1).Value = mat
 End Sub

（γ） 2016/12/31(土) 08:15

 説明文を読みました。
 すでにγさんから最速の処理コードが提示されていますが、あえて、アップしたセルへの直接書きこみループの形で。

 シート名、★のところは実際のものに変更してください。

 質問 B) についてはγさん指摘の条件をよく吟味して決定されればいいかと。
 日毎に１枚のシートで、複数シートを蓄積する方法もあるでしょうし、一日に何回かの情報を保持するとすれば
 日・時刻をシートにしたもので保持するということになるでしょう。
 これらは、別ブックとして持っておくことが安全かと思います。

 Sub Sample2()
    Dim shF As Worksheet
    Dim shT As Worksheet
    Dim i As Long
    Dim x As Long

    Set shF = Sheets("Sheet1")  '★元シート　シート名は実際のものに
    Set shT = Sheets("Sheet2")  '★転記シート　シート名は実際のものに

    '時刻軸の転記
    shF.Range("A18:A291").Copy shT.Range("D18")
    '通貨行の転記
    shT.Range("E17:V17").Value = WorksheetFunction.Transpose(shF.Range("A292:A309"))
    'データ転記
    x = 18
    For i = 310 To 5241 Step 18
        shT.Range("E" & x).Resize(, 18).Value = WorksheetFunction.Transpose(shF.Range("A" & i).Resize(18))
        x = x + 1
    Next

 End Sub

（β） 2016/12/31(土) 09:36

コメント返信：

[ 一覧(最新更新順) ]

[[20161231004826]] 『縦5267行１列のデータをマクロで一覧表形式に整形』（ｉｂｏｉｂｏ） ページの最後に飛ぶ

[[20161231004826]]　『縦5267行１列のデータをマクロで一覧表形式に整形』（ｉｂｏｉｂｏ）　ページの最後に飛ぶ