OKWAVEのAI「あい」が美容・健康の悩みに最適な回答をご提案!
-PR-
解決
済み

繰り返し1行~28行までを順順にコピーする方法

  • 困ってます
  • 質問No.181376
  • 閲覧数162
  • ありがとう数5
  • 気になる数0
  • 回答数6
  • コメント数0

お礼率 79% (95/120)

(B1:B28)を選択しD2に貼り付け(値・行列入れ替え)
(B29:B56)を選択しD3に貼り付け(値・行列入れ替え)
(B57:B84)を選択しD4に貼り付け(値・行列入れ替え)
:
:
:

といった感じに28個セルを選択し順順に貼り付けていく作業を行っているのですが330回くらい繰り返すのであまりに大変なのでマクロを作成しました。やはり途中で操作ミスなどありましたがなんとか記録できました。

しかしこれはVBAで作成すればもっとスマートにできるかな?と思い質問させて頂きます。
どなたかわかる方いれば宜しくお願いします。
通報する
  • 回答数6
  • 気になる
    質問をブックマークします。
    マイページでまとめて確認できます。

質問者が選んだベストアンサー

  • 回答No.3
レベル10

ベストアンサー率 38% (54/141)

こんな感じ?

Sub Transpose28()

Dim i As Integer
Application.ScreenUpdating = False
For i = 1 To 330
Cells(i * 28 - 27, 2).Resize(28).Select
Selection.Copy
Cells(i + 1, 4).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
お礼コメント
masa2000z28

お礼率 79% (95/120)

ありがとうございます。
おかげでかなり楽な作業になりました。
またよろしくお願いします。
投稿日時 - 2001-12-12 11:02:18
-PR-
-PR-

その他の回答 (全5件)

  • 回答No.1
レベル12

ベストアンサー率 65% (276/422)

意味不明なのですが・・・ とりあえず、この書き込みを見た人の多くは Step 27 という文字がうかんでいると思うのですが、処理の内容がよくわからないために、回答をできないでいるのだと思います。 複数行のコピーを繰り返してますが、貼り付け先は[D2/D3/D4]と範囲を持っていません。 これでは直前に貼り付けた値が、常に上書きされるはずです。 また >(値・行列入れ替え) の部分 ...続きを読む
意味不明なのですが・・・

とりあえず、この書き込みを見た人の多くは
Step 27
という文字がうかんでいると思うのですが、処理の内容がよくわからないために、回答をできないでいるのだと思います。

複数行のコピーを繰り返してますが、貼り付け先は[D2/D3/D4]と範囲を持っていません。
これでは直前に貼り付けた値が、常に上書きされるはずです。
また
>(値・行列入れ替え)
の部分は、全くどのような法則で行われているのか全く記述されておりません。

質問エリアは800文字しか記入できませんが、補足欄には文字制限が無いので、できたら記録したマクロコードを貼り付けてもらえませんか?

その方がみんなもわかりやすいと思います。
補足コメント
masa2000z28

お礼率 79% (95/120)

申し訳ございません。説明不足でした、補足させていただきます。
B1:B28を選択しコピーします。

D1を右クリックし「形式を指定して貼り付け」を選び「値」と「行列を入れ替える」を選択し(演算の項目はしないのままです)貼り付けを行います。

行列を入れ替えて貼り付けているので
<B1:B28→D1:AE1>に貼り付けとことになります。

下記がコードになります
Range("B1:B28").Select
Selection.Copy
Range("D1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

Range("B29:B56").Select
Application.CutCopyMode = False
Selection.Copy
Range("D2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True


Range("B57:B84").Select
Application.CutCopyMode = False
Selection.Copy
Range("D3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

お願いします
投稿日時 - 2001-12-07 17:20:41
  • 回答No.2
レベル11

ベストアンサー率 34% (97/285)

常に28行コピーするのであればループさせればよいだけだと思います。 loopとかnextとかでヘルプを参照してください。
常に28行コピーするのであればループさせればよいだけだと思います。

loopとかnextとかでヘルプを参照してください。
  • 回答No.4
レベル10

ベストアンサー率 38% (54/141)

再び。すみません、補足を読んでいませんでした。 Paste:=xlAll は Paste:=xlValues に替えて下さい。
再び。すみません、補足を読んでいませんでした。
Paste:=xlAll は Paste:=xlValues に替えて下さい。
  • 回答No.5
レベル14

ベストアンサー率 28% (4322/15241)

先に回答されている方と同じですが、極く短く Private Sub CommandButton1_Click() j=2 for i=1 to 200 step 8 ’200は仮の例 Range(Cells(i, 1), Cells(i+8, 1)).Copy 'A列について Cells(j, 2).PasteSpecial Paste:=xlValue, Transpose:=Tru ...続きを読む
先に回答されている方と同じですが、極く短く
Private Sub CommandButton1_Click()
j=2
for i=1 to 200 step 8 ’200は仮の例
Range(Cells(i, 1), Cells(i+8, 1)).Copy 'A列について
Cells(j, 2).PasteSpecial Paste:=xlValue, Transpose:=True
j=j+1 ’B2からよこに、B3からよこに、B4から横に・・・値だけコピー
next i
End Sub
テストをし易くするため28個を8個の縦の数値を横にする例に変えました。
お礼コメント
masa2000z28

お礼率 79% (95/120)

ありがとうございます。
こんなに短くできるんですね。。
もっと勉強したいとおもいます。
ありがとうございました。
投稿日時 - 2001-12-12 11:03:51
  • 回答No.6
レベル13

ベストアンサー率 68% (791/1163)

セルD1に  =INDIRECT("B"&(ROW()-1)*28+COLUMN()-3) を入力して、必要なだけコピーしてもできますね。 皆さんと同じようなマクロですが、Forループから数値をとってみました。 最終行をシートの一番下から探しています。 Sub DataCopy()   Dim rw As Long '行カウンタ   ...続きを読む
セルD1に
 =INDIRECT("B"&(ROW()-1)*28+COLUMN()-3)
を入力して、必要なだけコピーしてもできますね。


皆さんと同じようなマクロですが、Forループから数値をとってみました。
最終行をシートの一番下から探しています。

Sub DataCopy()
  Dim rw As Long '行カウンタ

  Application.ScreenUpdating = False '画面更新を止める

  'B列の入力されている最後まで、B1から28個飛びで処理していく
  For rw = 1 To Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row Step 28
    '行方向のコピー。28個
    Range(Cells(rw, 2), Cells(rw + 28 - 1, 2)).Copy
    '列方向に貼り付け。コピー開始行から貼り付け先の行番号を計算。列はDなので4
    Cells((rw - 1) \ 28 + 1, 4).PasteSpecial Paste:=xlValues, Transpose:=True
  Next

  Application.ScreenUpdating = True '画面更新
End Sub
お礼コメント
masa2000z28

お礼率 79% (95/120)

D1のセルに入力するだけでもできるとは・・・・
まだまだ色々勉強していきたいとおもいます。
ありがとうございます。
投稿日時 - 2001-12-12 11:05:29
このQ&Aのテーマ
このQ&Aで解決しましたか?
関連するQ&A
-PR-
-PR-
こんな書き方もあるよ!この情報は知ってる?あなたの知識を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する
-PR-
-PR-
-PR-

特集


いま みんなが気になるQ&A

関連するQ&A

-PR-

ピックアップ

-PR-
ページ先頭へ