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

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

しかしこれはVBAで作成すればもっとスマートにできるかな?と思い質問させて頂きます。
どなたかわかる方いれば宜しくお願いします。

このQ&Aに関連する最新のQ&A

A 回答 (6件)

こんな感じ?



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
    • good
    • 4
この回答へのお礼

ありがとうございます。
おかげでかなり楽な作業になりました。
またよろしくお願いします。

お礼日時:2001/12/12 11:02

セル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
    • good
    • 1
この回答へのお礼

D1のセルに入力するだけでもできるとは・・・・
まだまだ色々勉強していきたいとおもいます。
ありがとうございます。

お礼日時:2001/12/12 11:05

先に回答されている方と同じですが、極く短く


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個の縦の数値を横にする例に変えました。
    • good
    • 0
この回答へのお礼

ありがとうございます。
こんなに短くできるんですね。。
もっと勉強したいとおもいます。
ありがとうございました。

お礼日時:2001/12/12 11:03

再び。

すみません、補足を読んでいませんでした。
Paste:=xlAll は Paste:=xlValues に替えて下さい。
    • good
    • 1

常に28行コピーするのであればループさせればよいだけだと思います。



loopとかnextとかでヘルプを参照してください。
    • good
    • 1

意味不明なのですが・・・



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

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

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

その方がみんなもわかりやすいと思います。

この回答への補足

申し訳ございません。説明不足でした、補足させていただきます。
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
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QA4-2枚集約→A4-1枚にコピーしたいです

いつもお世話になっております。

A4に2枚集約(2アップ)にしてある資料を、A4に1枚裏表にコピーし直したいです。
【元の資料】A4 左側No.1 右側No.2となっているものを(裏は白紙)、
【出来上がり】A4 表No.1 裏No.2にするということです。

【元の資料】をA3に拡大して折ればいいのですが、それだとかさばってしまい、できればA4両面にしたいです。
あと、かなり枚数があるので、できればA3で出力して裁断して節約したいのですが、これは難しいですよね。
【元の資料】A4に、一枚目No.1とNo.2、二枚目No.3とNo.4…となってますから。

コピー機はキンコーズに行くので、性能はいいはずです。

コピーがお得の方、知恵をお貸しください。

Aベストアンサー

キンコーズのコピー機がわかりませんが、多分最新かつ高性能の
機械が入っているはずです。

最近はコンビニなどのコピー機でも両面コピーが可能です。
最初に両面コピーを選んでコピーすれば、1枚目のスキャン、
2枚目のスキャンの順で手順が示されます。
ちょっと難しいのは表面と裏面の上下あわせくらいです。

QExcel整形処理:列ごと&12行おきに「行列を入れ替えて貼り付け」

ExcelデータをVBAで次のように処理したいのですが、ご助力いただけますでしょうか。

Sheet1のD列とE列に4万行ほどの数値データがあります(行数は必ず12で割り切れます)。
このデータを、列ごと&12行おきに「行列を入れ替えて貼り付け」みたいなことをSheet2に
施したいです。具体的なイメージとしては、

【処理前】
D列 E列
----------
D1 E1
D2 E2
D3 E3
:(略)
D35 E35
D36 E36
:(略)

【処理後】
D1 D2 D3 D4 D5 D6 D7 D8 D9 D10 D11 D12 E1 E2 E3 E4 E5 E6 E7 E8 E9 E10 E11 E12■ここで改行
D13 D14 D15 D16 D17 D18 D19 D20 D21 D22 D23 D24 E13 E14 E15 E16 E17 E18 E19 E20 E21 E22 E23 E24■ここで改行
D25 D26 D27 D28 D29 D30 D31 D32 D33 D34 D35 D36 E25 E26 E27 E28 E29 E30 E31 E32 E33 E34 E35 E36■ここで改行
:(略)


なお、テキストエディタを介することによってなら、解決策が見つかりました。
(1) E列の右(=F列)に12行ごとに@などの目印をつけます。
(2) E列、F列を選択・コピーし、テキストエディタに貼りつけます。
(3) 置換でまず\nを全て除去し、次にもう一度置換で\t@を\nに。
(4) D列も同様の手順です。

ExcelデータをVBAで次のように処理したいのですが、ご助力いただけますでしょうか。

Sheet1のD列とE列に4万行ほどの数値データがあります(行数は必ず12で割り切れます)。
このデータを、列ごと&12行おきに「行列を入れ替えて貼り付け」みたいなことをSheet2に
施したいです。具体的なイメージとしては、

【処理前】
D列 E列
----------
D1 E1
D2 E2
D3 E3
:(略)
D35 E35
D36 E36
:(略)

【処理後】
D1 D2 D3 D4 D5 D6 D7 D8 D9 D10 D11 D12 E1 E2 E3 E4 E5 E...続きを読む

Aベストアンサー

SHEET1のD1~E48000を入れ替えながら、SHEET2のA1から
始まる縦2000x横24のデータへ変換するマクロです。
エクセルマクロの基本として、一度配列に落としてから
シートに流し込む方が効率がよいです。
配列は0から始まりますがCELLSは1から始まるため、
若干混乱するかもしれません。

max_col = 24
max_row = 2000

Dim a()
ReDim a(max_row - 1, max_col - 1)
For i = 0 To max_col - 1
For j = 0 To max_row - 1
a(j, i) = Sheets("Sheet1").Range("D1").Offset((i Mod 12) + 12 * j, i \ 12)
Next
Next


Sheets("Sheet2").Range(Cells(1, 1), Cells(max_row, max_col)).Value = a

Qコピー機でA4は縦と横どちらがよい?

コピー機の給紙トレイにA4の紙をいれますが、オフィスにあるものは横長方向に入っているものが多いです。
しかしA3がコピーできる場合、A4は縦長にいれ、縦長に読み込んでコピーしたほうがドラムを通過する距離が短くなって、速度UPとドラムの寿命を長くすることができるような気がします。それでも通常横長に入っているのでこれには何か意図があるのでしょうか?

意味不明な質問ですがよろしくお願いします。

Aベストアンサー

お考えの通り、事務機業界ではA4縦長(というか、これをA4横送りと言います)が標準で、マシンもそれを想定して設計されています。速度を表現する場合も当然A4横送りで比較します。

では縦送りの用途ですが、これはA3からA4の縮小コピーで必要になります。
特にアナログ方式のコピー機ではこれは必須で、A4横送りしか用紙がセットされていないと、A3からA4への縮小がまったく出来ません。

最近主流のデジタルコピー機では、画像を一旦記憶し、A4に縮小後、90度画像を回転させてから書き込むことが可能なため、実はA4縦送りのセットは不要です。
しかしながら、原稿自動送り装置に原稿をセットする際、A3、B4は縦送り、A4、B5は横送りというのがすぐに理解できないユーザーが多い会社では、いちいち説明が面倒なので、原稿の向きを全サイズ揃えた方が判りやすいため、A4、B5とも縦送りでセットするケースが多いです。

(実を言うと、デジタルコピーでは等倍コピー時も画像回転が可能ですから、本当は、原稿セットは縦送り統一でもA4、B5は横送りセットでOKなんですがね。。)

お考えの通り、事務機業界ではA4縦長(というか、これをA4横送りと言います)が標準で、マシンもそれを想定して設計されています。速度を表現する場合も当然A4横送りで比較します。

では縦送りの用途ですが、これはA3からA4の縮小コピーで必要になります。
特にアナログ方式のコピー機ではこれは必須で、A4横送りしか用紙がセットされていないと、A3からA4への縮小がまったく出来ません。

最近主流のデジタルコピー機では、画像を一旦記憶し、A4に縮小後、90度画像を回転させてから書き込むことが可能なた...続きを読む

Qマクロ 検索した条件に対応する値を選択したセルに貼り付ける マクロでsheet1のBの名前をshe

マクロ 検索した条件に対応する値を選択したセルに貼り付ける

マクロでsheet1のBの名前をsheet2のA列から検索してsheet2のF列をsheet1で選択したセルへ貼り付けたいです。
良い方法はないでしょうか?(٭°̧̧̧ω°̧̧̧٭)
助けてください!!

Aベストアンサー

ここの掲示板で常連のある方の回答なら、ある程度決まったパターンで回答します。

単なる想像ですが、もしかしたら、質問の要素の肝心な説明が抜けていませんか?

これは、私の回答者としての想像ですが、抜けているのは、
「上の画像は、月次報告のデータ」
「下の画像は、年次データリスト」

この年次リストの月次報告データのそれぞれのスタッフのデータを年次データ・リストに転記する
(回答者としても、10数年も経理や総務で、表を作ってきた人間もいますから、なんとなくわかるものはわかります。)

>マクロでsheet1のBの名前をsheet2のA列から検索してsheet2のF列をsheet1で選
>択したセルへ貼り付けたいです。

この文章そのものは、Sheet1 もSheet2 も間違っていないのではありませんか?画像の表示が間違えたということだと思うのです。

本来順序が同じなら、そのままコピー&ペーストで行けるはずですが、そうとはなっていないのでしょう。やめた社員などあると順序が狂うわけですね。

コードは汚いのですが、一応、考えてみました。

'//
Sub FilledNumbers()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim cls As Long, cld As Long 'cls=ソース側, cld =目的側 destine
Dim i As Variant, j As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")

With sh1
 Set rng1 = .Range("B1", .Cells(Rows.Count, 2).End(xlUp))
 'データ1行目からのほうが特定しやすい、B列名前欄
 cls = .Cells(1, Columns.Count).End(xlToLeft).Column
 'Sheet1 の最後の列を探している
 cls = cls - 1 '名前欄が、2列目だから、1列減る
End With
With sh2
 Set rng2 = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
 cld = .Cells(1, Columns.Count).End(xlToLeft).Column
 '月次だから、月によって変わる。必ず7月なら7月というタイトルが必要
 If cld < 2 Then cld = 2  '使うことはないはず
End With

For j = 2 To rng1.Rows.Count
If rng1.Cells(j, cls).Value <> "" Then
  i = Application.Match(rng1.Cells(j, 1).Value, rng2, False)
  If IsNumeric(i) Then
   rng2.Cells(i, cld).Value = rng1.Cells(j, cls).Value
  Else
   rng1.Cells(j, cls).Offset(, 1).Value = "x"
   '見つからなかった場合に x をつける
  End If
End If
Next
End Sub

ここの掲示板で常連のある方の回答なら、ある程度決まったパターンで回答します。

単なる想像ですが、もしかしたら、質問の要素の肝心な説明が抜けていませんか?

これは、私の回答者としての想像ですが、抜けているのは、
「上の画像は、月次報告のデータ」
「下の画像は、年次データリスト」

この年次リストの月次報告データのそれぞれのスタッフのデータを年次データ・リストに転記する
(回答者としても、10数年も経理や総務で、表を作ってきた人間もいますから、なんとなくわかるものはわかります。)

>マ...続きを読む

Qコンビニのコピー機で拡大 A4→A2

コンビニのコピー機で、A4→A2に拡大コピーは出来るんでしょうか?

A2用紙1枚で出来なくても、A4用紙を4枚出力でもいいのですが・・・

出来るのであれば、やり方を教えて下さい。
宜しくお願いします。

Aベストアンサー

セブンイレブンだと
ポスター作成にすればできるでしょう

参考URL:http://www.sej.co.jp/services/copy.html

Q形式(値だけ)を選択して貼り付けたい:コード修正願い

お世話になります。VBA 初心者です。

以下のコードを、タイトルにあります通りmaRng の値だけを
worksheet に貼り付けたいのですが、どのように修正すれば
よいですか。

myRng.Copy wS.Cells(Rows.Count, "A").End(xlUp).Offset(1)

よろしくお願い致します。

Aベストアンサー

こんにちは

手操作での「形式を選択して貼り付け」-「値」と同等の処理をなさればよろしいかと。
具体的にはPasteSpecialメソッドを利用することで可能です。
一旦copyしておいて、pasteSpecialとなるので、copyメソッドのように1行ではなく2行の記述になりますが・・・
https://msdn.microsoft.com/ja-jp/library/office/ff839476.aspx

あるいは、すでに#1様が回答済ですが、値を代入する記述法に変えることでももちろん可能です。
wS.Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = myRng.Value

QA4文書のコピー代について

子どもの関係で役員をしていますが、行事等の案内書を作成する係に
なっています。

A4にごく普通の案内文と、ちょっとした地図(カラー)をコピー
した場合、1枚あたりのコストはおいくら程でしょうか。
白黒のみでフォント10程度で埋めた場合はいかがでしょう。

機種はキャノンMP500(インクジェット)です。
(メーカーに問い合わせしましたが、情報が足りないため回答不能
とのことでした。ですので、おおよそでも知りたいのですが)
行事も年に数回あり、その都度30枚ほどコピーし、今回まとめて
の請求となり困っています。
よろしくお願いいたします。

Aベストアンサー

 原稿用紙は無料。コンビニでコピーで10円。
 自宅プリンタですると安くはなりますが、ただ同然扱いになりかねません。主に用紙代ぐらいでしょうか?
 金額をはっきりさせたいのであればコンビニでコピー。5円の所もありますね。後はレジで領収書を発行してもらう、領収書の発行もしてくれるものもコンビニではある。

 プリンタでははっきり言ってわかりません。印刷面はどれぐらいの割合かでも変わります。だからわかりませんとしか言えません。
 色が分離しているとわかりやすいのですが、複数の色を一つのカートリッジで使用する形ですと、他の色が大量余っていても一色がだめだとすべて駄目になることがあります。

 私は用紙代を請求する程度です。用紙も安いものを使用していますのでボランティアの状態でもありますが。

Q形式(値だけ)を選択して貼り付けたい:コード修正願い

お世話になります。
午前中に似た様な質問をさせて頂いたのですが、苦闘しており
お知恵を拝借したく再度質問を致します。

以下の様なコード(一部)でset myRng の値だけ(もしできればA列~F列まで)
workingsheet に貼り付けたいのですが、どのように修正を
行えばよいでしょうか? よろしくお願い致します。

lastRow = .Cells(Rows.Count, "A").End(xlUp).Row '
lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column '
Set myRng = Range(.Cells(2, "A"), .Cells(lastRow, lastCol)).SpecialCells(xlCellTypeVisible)
myRng.Copy wS.Cells(Rows.Count, "A").End(xlUp).Offset(1)


本日中には補足やお礼をできないかもしれませんが、
何卒よろしくお願いします。

Aベストアンサー

前回のご質問の読んでいたけれども、間に合わなかったようです。

前回のご質問で解決をしたのなら良かったけれども、配列での値コピーは、両方のサイズを同じにしないて行けませんし、今回のようなVisible セルだけの値をコピーするのは前回の方法では、逆に複雑になってしまったように思います。

私の記憶では、オートフィルタだけなら、
 SpecialCells(xlCellTypeVisible)
は不要だったと思います。しかし、テーブルのフィルタでは利きませんので注意が必要になります。

以下は、貼り付け先とデータ元と間違えると大変なことになりますから、十分に調べてから、本番でお使いになるようにしてください。

'//
Sub TestMacro()
  Dim myRng As Range
  Dim lastRow As Long, lastCol As Long
  Dim fn As String
  Dim fn2 As String
  Dim ws As Worksheet
  Dim ws2 As Worksheet
  
  fn = "BookA.xlsx" 'データ
  fn2 = "BookB.xlsm" '貼り付け先
  Set ws2 = Workbooks(fn).Worksheets("Sheet1")  'データ
  Set ws = Workbooks(fn2).Worksheets("Sheet1") '貼り付け先
  With ws2
    lastRow = .Cells(Rows.Count, "A").End(xlUp).Row '
    lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column '
    Set myRng = .Range(.Cells(2, "A"), .Cells(lastRow, lastCol)).SpecialCells(xlCellTypeVisible)
  End With
  If myRng Is Nothing Then Exit Sub 'これはありえないかもしれません 
  myRng.Copy
  ws.Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)
  Application.CutCopyMode = False
End Sub

前回のご質問の読んでいたけれども、間に合わなかったようです。

前回のご質問で解決をしたのなら良かったけれども、配列での値コピーは、両方のサイズを同じにしないて行けませんし、今回のようなVisible セルだけの値をコピーするのは前回の方法では、逆に複雑になってしまったように思います。

私の記憶では、オートフィルタだけなら、
 SpecialCells(xlCellTypeVisible)
は不要だったと思います。しかし、テーブルのフィルタでは利きませんので注意が必要になります。

以下は、貼り付け先とデータ元と間違...続きを読む

QA3まで対応のコピー機ってA4も印刷できるんですか

題名の通りですが
「A3まで対応」と書いてあるコピー機はA4の印刷も可能なのでしょうか?
いまいち紙のサイズについて詳しくないのですが
A3が印刷可能なら当然A4も印刷できますよね?

よろしくお願い致します。

Aベストアンサー

リ○ー の使ってますが A3(大)から はがきサイズ(小)までなら 出来ます。
なので A4も当然出来ますよ。
購入するときに、ブ○ザ-も 検討しましたが やっぱり出来るようでした。
私は B5までしかした事ありませんが・・・。

QエクセルVBAでsheet1!B2:B10までの値をsheet2!B2

エクセルVBAでsheet1!B2:B10までの値をsheet2!B2:K2にコピーする方法を教えて下さい。

Aベストアンサー

>sheet1!B2:B10までの値をsheet2!B2:K2にコピーする

そもそもセルの個数が合ってませんが,何がしたいのですか?

基本:値の転送
worksheets("Sheet2").range("B2:J2").value = _
application.transpose(worksheets("Sheet1").range("B2:B10"))


個数を数えるところからやりたいならその通り数を拾って,resize等してください。
応用:
dim h as range
set h = worksheets("Sheet1").転送元のセル範囲縦一列
worksheets("Sheet2").range("B2").resize(1, h.rows.count),value = application.transpose(h)


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報