Excel VBA質問箱 IV

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

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


12187 / 76734 ←次へ | 前へ→

【70073】Re:貼り付けるデータを一定間隔で分割して貼り付けたい
発言  げっち  - 11/10/13(木) 19:20 -

引用なし
パスワード
   ▼kanabun さん:

回答ありがとうございます。

>
>こんな方法はどうでしょう
>Sheet1に元表があって、これを Sheet2 に 31列づつCopyします。
>そのとき、32列目に 連番を振っておきます。
>全列コピーし終わったら、Sheet2全体を(32列目をキーにして)ソート
>します。
>これで指定の順に並び替えられます。
>
>Sub Try1() 'Sheet1 → Sheet2
>  Dim i&, j&
>  Dim n&, m&
>  Const Stp = 31 '31列づつ
>  Dim wk() As Long
>  Dim CopyTo As Range
>  
>  With Sheet2
>    .UsedRange.ClearContents
>    Set CopyTo = .Cells(1)
>  End With
>  With Sheet1.UsedRange
>    m = .Columns.Count
>    n = .Rows.Count
>    ReDim wk(1 To n, 1 To 1)
>    For i = 1 To n
>      wk(i, 1) = i
>    Next
>    For j = 1 To m Step Stp  'Stp列づつまとめてCopy
>      .Columns(j).Resize(, Stp).Copy CopyTo
>      CopyTo.Offset(, Stp).Resize(n).Value = wk
>      Set CopyTo = CopyTo.Offset(n)
>    Next
>  End With
>  With Sheet2.Cells(1).CurrentRegion
>    .Sort Key1:=.Columns(Stp + 1), Header:=xlNo'列見出しなし
>    .Columns(Stp + 1).Clear
>  End With
>
>End Sub

上記の方法で行うことができました。ありがとうございます。

ただ、データが1行(横)ではなく、1列(縦)の場合もあるのですが、
その場合はどこがどう変わるのでしょうか。

例えとしては、












これを、

あか
いき
うく
えけ
おこ

こうしたいです。
5 hits

【70063】貼り付けるデータを一定間隔で分割して貼り付けたい げっち 11/10/13(木) 12:10 質問
【70064】Re:貼り付けるデータを一定間隔で分割して... UO3 11/10/13(木) 13:48 発言
【70065】Re:貼り付けるデータを一定間隔で分割して... げっち 11/10/13(木) 15:36 発言
【70066】Re:貼り付けるデータを一定間隔で分割して... kanabun 11/10/13(木) 16:44 発言
【70073】Re:貼り付けるデータを一定間隔で分割して... げっち 11/10/13(木) 19:20 発言
【70074】Re:貼り付けるデータを一定間隔で分割して... kanabun 11/10/13(木) 20:08 発言
【70081】Re:貼り付けるデータを一定間隔で分割して... げっち 11/10/14(金) 10:20 お礼
【70067】Re:貼り付けるデータを一定間隔で分割して... UO3 11/10/13(木) 17:19 発言
【70068】Re:貼り付けるデータを一定間隔で分割して... UO3 11/10/13(木) 17:22 発言
【70069】Re:貼り付けるデータを一定間隔で分割して... kanabun 11/10/13(木) 17:28 発言
【70070】Re:貼り付けるデータを一定間隔で分割して... UO3 11/10/13(木) 17:35 発言
【70072】Re:貼り付けるデータを一定間隔で分割して... kanabun 11/10/13(木) 18:03 発言

12187 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free