Excel VBA質問箱 IV

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

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


2695 / 13645 ツリー ←次へ | 前へ→

【66527】列を追加してシート名前を列挙 ジャラール 10/9/8(水) 20:59 質問[未読]
【66531】Re:列を追加してシート名前を列挙 かみちゃん 10/9/8(水) 21:52 発言[未読]
【66532】Re:列を追加してシート名前を列挙 ジャラール 10/9/8(水) 22:17 回答[未読]
【66534】Re:列を追加してシート名前を列挙 かみちゃん 10/9/8(水) 22:32 発言[未読]
【66535】Re:列を追加してシート名前を列挙 ジャラール 10/9/8(水) 22:47 お礼[未読]

【66527】列を追加してシート名前を列挙
質問  ジャラール  - 10/9/8(水) 20:59 -

引用なし
パスワード
   ブックの構成

●1枚目:使わないシート
●2枚目〜8枚目:縦に結合したいシート
  それぞれ同じフォーム「A5〜F15にデータあり」
  ただし、5行目はタイトル行

したいこと
●2枚目〜8枚目を縦に結合したい。
●タイトル行は先頭のみ必要

という前提で以下のコードを書きました。
しかし、A列の左に1列追加して(罫線などの書式はA列と同じ)
シート名を各行のA列として縦にくっつけたいという要望がありました。
これに対応したいのですが、どう書いていいのか分かりません。


●1列追加のところはチャレンジしたましたが、エラーが出ました。
●シート名を各行のA列として縦にくっつける部分は全く分かりません。

申し訳ないですが、プログラムを教えてもらえないでしょうか?
よろしくお願いします。


Sub 結合()
 Dim Worksheet As Worksheet
 Dim DATA1 As Range, DATA2 As Range
 Dim i As Integer
 
 '入力ボックスにてシート名前、出力先、出力データセットを入力する。
 '先頭にシートを作成する
 Sheets(3).Copy before:=Sheets(1)
 Sheets(1).Name = "縦結合"


 '最初にデータセットを出力する位置を設定する
 Set DATA1 = Worksheets("縦結合").Range("A6")

 For i = 3 To Worksheets.Count
   '結合したいデータセットをDATA2として読み込む。
   Set DATA2 = Sheets(i).Range("A6:F15")
   'DATA1をDATA2とする。
   DATA2.Copy DATA1
   '次のデータセットを出力する位置を設定する。
   Set DATA1 = DATA1.Offset(DATA2.Rows.Count)
 Next

 'A列をコピーして挿入する
 Sheets(1).Range("A").Copy
 Sheets(1).Range("B").Insert


 'データセットをリセットする。
 Set DATA1 = Nothing
 Set DATA2 = Nothing
  
End Sub

【66531】Re:列を追加してシート名前を列挙
発言  かみちゃん E-MAIL  - 10/9/8(水) 21:52 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>ブックの構成
>
>●1枚目:使わないシート
>●2枚目〜8枚目:縦に結合したいシート
>  それぞれ同じフォーム「A5〜F15にデータあり」
>  ただし、5行目はタイトル行
>
>したいこと
>●2枚目〜8枚目を縦に結合したい。
>●タイトル行は先頭のみ必要
>
>という前提で以下のコードを書きました。
>しかし、A列の左に1列追加して(罫線などの書式はA列と同じ)
>シート名を各行のA列として縦にくっつけたいという要望がありました。
>これに対応したいのですが、どう書いていいのか分かりません。
>
>
>●1列追加のところはチャレンジしたましたが、エラーが出ました。
>●シート名を各行のA列として縦にくっつける部分は全く分かりません。

以下のようなことがしたいのでしょうか?

Sub 結合()
 Dim Worksheet As Worksheet
 Dim DATA1 As Range, DATA2 As Range
 Dim i As Integer

 '入力ボックスにてシート名前、出力先、出力データセットを入力する。
 '先頭にシートを作成する
' Sheets(3).Copy before:=Sheets(1)
 Sheets.Add
 ActiveSheet.Name = "縦結合"
' Sheets(1).Name = "縦結合"


 '最初にデータセットを出力する位置を設定する
 Set DATA1 = Worksheets("縦結合").Range("A6")

 For i = 3 To Worksheets.Count
   '結合したいデータセットをDATA2として読み込む。
   Set DATA2 = Sheets(i).Range("A6:F15")
   'DATA1をDATA2とする。
   DATA2.Copy DATA1.Offset(, 1)
   DATA1.Resize(DATA2.Rows.Count).Value = Sheets(i).Name '★
   '次のデータセットを出力する位置を設定する。
   Set DATA1 = DATA1.Offset(DATA2.Rows.Count)
 
 Next

 'A列をコピーして挿入する
' Sheets(1).Range("A").Copy
' Sheets(1).Range("B").Insert
' Application.CutCopyMode = False
 

 'データセットをリセットする。
 Set DATA1 = Nothing
 Set DATA2 = Nothing
 
End Sub


>●1列追加のところはチャレンジしたましたが、エラーが出ました。

エラーが出る理由は、
 Sheets(1).Range("A:A").Copy
 Sheets(1).Range("B:B").Insert
としなければいけません。

>●シート名を各行のA列として縦にくっつける部分は全く分かりません。

上記の★の行のように処理すればできます。

【66532】Re:列を追加してシート名前を列挙
回答  ジャラール  - 10/9/8(水) 22:17 -

引用なし
パスワード
   ▼かみちゃん さん:

ありがとうございます。
コードのまずい部分の修正までしていただき
本当にありがとうございます。

しかし、とても失礼なことを承知で、1つだけコメントさせてください。
追加したA列には追加後のB列と同じ罫線情報が入るようにしたいのです。
ここの部分はどうカバーすればよいのでしょうか?

【66534】Re:列を追加してシート名前を列挙
発言  かみちゃん E-MAIL  - 10/9/8(水) 22:32 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>追加したA列には追加後のB列と同じ罫線情報が入るようにしたい

罫線を含むセルの書式設定もコピーしてもいいのであれば、

   DATA1.Resize(DATA2.Rows.Count).Value = Sheets(i).Name '★

の部分を

   With DATA1.Resize(DATA2.Rows.Count)
    .Value = Sheets(i).Name
    With .Resize(DATA2.Rows.Count)
     .Offset(, 1).Copy
     .Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
     Application.CutCopyMode = False
    End With
   End With

とすればできると思います。

【66535】Re:列を追加してシート名前を列挙
お礼  ジャラール  - 10/9/8(水) 22:47 -

引用なし
パスワード
   ▼かみちゃん さん:

何度も回答くださりありがとうございます。
やりたいことはこれで達成できましたが、
ゆっくり落ち着いて、教えていただいたコードを咀嚼し
吸収したいと思います。
本当に助かりました。

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