Excel VBA質問箱 IV

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

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


6320 / 13644 ツリー ←次へ | 前へ→

【45901】行をコピーし別のセルに行列入替でコピーしたい 超初心者 07/1/17(水) 18:28 質問[未読]
【45902】Re:行をコピーし別のセルに行列入替でコピ... へっぽこ 07/1/17(水) 18:35 回答[未読]
【45904】Re:行をコピーし別のセルに行列入替でコピ... 超初心者 07/1/17(水) 18:43 お礼[未読]
【45905】Re:行をコピーし別のセルに行列入替でコピ... へっぽこ 07/1/17(水) 18:47 発言[未読]
【45907】Re:行をコピーし別のセルに行列入替でコピ... 超初心者 07/1/17(水) 18:49 質問[未読]
【45909】Re:行をコピーし別のセルに行列入替でコピ... へっぽこ 07/1/17(水) 19:01 発言[未読]
【45933】Re:行をコピーし別のセルに行列入替でコピ... 超初心者 07/1/18(木) 11:40 お礼[未読]
【45940】Re:行をコピーし別のセルに行列入替でコピ... へっぽこ 07/1/18(木) 12:14 発言[未読]
【45941】Re:行をコピーし別のセルに行列入替でコピ... 超初心者 07/1/18(木) 12:29 お礼[未読]

【45901】行をコピーし別のセルに行列入替でコピー...
質問  超初心者  - 07/1/17(水) 18:28 -

引用なし
パスワード
   横一行が1データで、項目がAからDまであります。このデータを行列入替し、さらに別シートにコピーしたいのです。1回だけならマクロの記録で以下のようになりました。

Range("A1:D1").Select
  Selection.Copy
  Sheets("Sheet2").Select
  Range("A1").Select
  Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True

データが複数行ありますので、この処理を繰り返したいので、doループを用いて、

Range("A1:D1").Select
  Do Until ActiveCell.Value = ""
  Selection.Copy
  Sheets("Sheet2").Select
  Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
  Sheets("Sheet1").Select
  Selection.Offset(1).Select
  Loop

としましたが、上記ですと、コピー元はどんどんコピーしていきますが、ペースト先は同じ場所に上書きペーストを繰り返すだけです。次々と縦にペーストしていきたいのです。

たぶんブランクのセルを指定してそこへペーストしなさいと書けばよいのでしょうが、blankは知っているものの、埋まっているセルをどう表現するのか知りません。

また、A1:D1は全ての行の見出しとなっており、A1:D1とA2:D2、A1:D1とA3:D3と全ての行にA行を見出しとしてつけたいのです。

もう全くわかりません。

ご教授くださると大変助かります。宜しくお願いいたします。

【45902】Re:行をコピーし別のセルに行列入替でコ...
回答  へっぽこ  - 07/1/17(水) 18:35 -

引用なし
パスワード
   こんにちは。
何らかの方法で貼り付ける先をずらしてゆけば良いので以下のような
感じでしょうか。

Sub サンプル()
  Dim 貼付行 As Long
  
  貼付行 = 1
  
  Range("A1:D1").Select
  Do Until ActiveCell.Value = ""
    Selection.Copy
    Sheets("Sheet2").Select
    Cells(貼付行, "A").Select
    Selection.PasteSpecial Paste:=xlPasteAll, _
      Operation:=xlNone, SkipBlanks:=False, _
      Transpose:=True
    貼付行 = 貼付行 + 4
    Sheets("Sheet1").Select
    Selection.Offset(1).Select
  Loop
End Sub

【45904】Re:行をコピーし別のセルに行列入替でコ...
お礼  超初心者  - 07/1/17(水) 18:43 -

引用なし
パスワード
   ▼へっぽこ さん:
有難うございます。4列コピーするからセル+4と考えればよいのですね。考えすぎてました。

私が望んでいたコピー&行列変換別シートへのペーストはこれで出来ました。あとは、どの行にも必ずA行(見出し)をくっつけてペーストしたいのです。

宜しくお願いいたします。

【45905】Re:行をコピーし別のセルに行列入替でコ...
発言  へっぽこ  - 07/1/17(水) 18:47 -

引用なし
パスワード
   > どの行にも必ずA行(見出し)をくっつけてペーストしたいのです。

A行とはどこでしょう?
Sheet1のA1セル?

※19時で帰っちゃいます。

【45907】Re:行をコピーし別のセルに行列入替でコ...
質問  超初心者  - 07/1/17(水) 18:49 -

引用なし
パスワード
   ▼へっぽこ さん:
>> どの行にも必ずA行(見出し)をくっつけてペーストしたいのです。
>
>A行とはどこでしょう?
>Sheet1のA1セル?
>
>※19時で帰っちゃいます。

ごめんなさい、表現を間違えました。最初の一行目ですから1行です。

【45909】Re:行をコピーし別のセルに行列入替でコ...
発言  へっぽこ  - 07/1/17(水) 19:01 -

引用なし
パスワード
   こういうことですか?

Sub サンプル1()
  Dim 貼付行 As Long
  Dim コピー行 As Long
 
  貼付行 = 1
  コピー行 = 2
  Sheets("Sheet1").Select
  Do Until Cells(コピー行, "A").Value = ""
    Range("A1:D1").Copy
    Sheets("Sheet2").Select
    Cells(貼付行, "A").Select
    Selection.PasteSpecial Paste:=xlPasteAll, _
      Operation:=xlNone, SkipBlanks:=False, _
      Transpose:=True
      
    Sheets("Sheet1").Select
    Cells(コピー行, "A").Resize(, 4).Copy 'Resizeで4列にする
    Sheets("Sheet2").Select
    Cells(貼付行, "B").Select
    Selection.PasteSpecial Paste:=xlPasteAll, _
      Operation:=xlNone, SkipBlanks:=False, _
      Transpose:=True
      
    Sheets("Sheet1").Select
    貼付行 = 貼付行 + 4
    コピー行 = コピー行 + 1
  Loop
End Sub

いまいち話が見えない…
今日は帰ります。

【45933】Re:行をコピーし別のセルに行列入替でコ...
お礼  超初心者  - 07/1/18(木) 11:40 -

引用なし
パスワード
   ▼へっぽこ さん:
おおお!!!まさにのぞみどおりのことが出来ました。へっぽこさん、感謝してもしきれないです。

以下のことをしたかったのです。

施設名 患者名 薬剤 投与量
A      あ   a    10
B      い   b    20
      〜

上記を、
施設名 A
患者名 あ
薬剤  a
投与量 10
施設名 B
患者名 い
薬剤  b
投与量 20


本当に有難うございました。

【45940】Re:行をコピーし別のセルに行列入替でコ...
発言  へっぽこ  - 07/1/18(木) 12:14 -

引用なし
パスワード
   合ってましたか。良かった。

昨日は混乱すると思いあえて必要最小限の改造としましたが
以下のようにシートを切り替えなくて済むようにできます。

Sub サンプル2()
  Dim 貼付行 As Long
  Dim コピー行 As Long

  貼付行 = 1
  コピー行 = 2
  
  Sheets("Sheet2").Select
  
  Do Until Sheets("Sheet1").Cells(コピー行, "A").Value = ""
    'Cells()やRange()の前にシート名を書くと、書いたシート名の
    'セルと言うことになります。
    Sheets("Sheet1").Range("A1:D1").Copy
    'シート名が付いていないと現在表示しているシートのセルになります。
    Cells(貼付行, "A").Select
    Selection.PasteSpecial Paste:=xlPasteAll, _
      Operation:=xlNone, SkipBlanks:=False, _
      Transpose:=True
   
    Sheets("Sheet1").Cells(コピー行, "A").Resize(, 4).Copy 'Resizeで4列にする
    '上ではCells().Select→Selection.PasteSpecialと2段階で書いてますが
    '実は下のようにCells()..PasteSpecialと1つに纏められます。
    Cells(貼付行, "B").PasteSpecial Paste:=xlPasteAll, _
      Operation:=xlNone, SkipBlanks:=False, _
      Transpose:=True
   
    貼付行 = 貼付行 + 4
    コピー行 = コピー行 + 1
  Loop
End Sub

またシートの指定もサンプル3のようにWith〜End Withで纏めることが出来ます。

Sub サンプル3()
'書き方1
  Sheets("Sheet1").Range("A1:D1").Interior.ColorIndex = 3
  Sheets("Sheet1").Cells(1, 1).Interior.ColorIndex = 4
'書き方2(書き方1と同じ意味になる)
  With Sheets("Sheet1")
    .Range("A1:D1").Interior.ColorIndex = 3
    .Cells(1, 1).Interior.ColorIndex = 4
  End With
'−−−−−
  Sheets("Sheet2").Select
  With Sheets("Sheet1")
    .Range("A1:D1").Interior.ColorIndex = 3 'Sheet1のA1〜D1
    '↓これは.で始まっていないのでwithの影響を受けない
    '(=現在表示されているシートのCells(1,1)ということになる)
    Cells(1, 1).Interior.ColorIndex = 5
    .Cells(1, 1).Interior.ColorIndex = 4 'Sheet1のA1
  End With
End Sub

時間があるときにヘルプを読んだりしてみてくださいませ。

【45941】Re:行をコピーし別のセルに行列入替でコ...
お礼  超初心者  - 07/1/18(木) 12:29 -

引用なし
パスワード
   ▼へっぽこ さん:
うーん、奥が深いというか、同じ結果を出すにも、違う書き方でも出来るんですね。(プログラムのセンスになるのかなぁ・・)そこまでのスキルはまだありませんので、これを機に勉強していきます。

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