みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel データの再配置

Excelでデータを再配置するマクロの組み方を教えて下さい!

参考画像→ http://goo.gl/2nLWH

画像左側のように複数のデータセットが縦方向に配置されているシートで、左上が「セット○」セルから始まるデータセット単位で横方向に空白列を挟んで再配置したいと思っています。
画像はサンプルデータで、実際には行数は不定数、列数は4列のセットが複数個存在します。

宜しくお願いします。

投稿日時 - 2013-06-12 09:31:56

QNo.8130368

困ってます

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

#2、#3、cjです。

> できました!今までのマクロはコードを見た時に大体どのように実行されているのかなとわかったのですが、貴方様のコードはマクロ初心者の小生にはチンプンカンプンです(笑)流石です!
馬鹿にしてます?(笑)
内容的には、マクロの記録をアレンジしたような、
VBAというよりは、とてもEXCEL一般機能寄りの処理をしています。
 Set rTgt = .Range("A:A").SpecialCells(Type:=xlCellTypeConstants)
 (手作業なら、A列を選択、F5キー、Alt+Sキー、Alt+Oキー、Enter)
で、A列にある定数セルを取得して
 rTgt.Areas(i).Resize(, 4)
 (手作業なら、Ctrl+Alt+Sキー Shift+→キーを3回、の繰り返し)
で、それぞれのセルブロック(領域)を4列に拡張して
 .Copy Destination:=Sheets("Sheet2").Cells(i * 5 - 4)
指定のセルに貼り付ける、、、
という内容です。

#3のコード、より堅実に書き直しました。
 
 
Sub Re8130368dd()
  Dim rTgt As Range
  Dim i As Long
  Set rTgt = Sheets("Sheet1").Range("A:A").SpecialCells(Type:=xlCellTypeConstants)
  If rTgt Is Nothing Then Exit Sub
  For i = 1 To rTgt.Areas.Count
    rTgt.Areas(i).Resize(, 4).Copy Destination:=Sheets("Sheet2").Cells(i * 5 - 4)
  Next i
  Set rTgt = Nothing
End Sub
 
 
> ちなみに列数を5列や6列にするにはどのように変数を与えてやればよいでしょうか?
6列の場合、を見てもらえれば、要領が分かると思います。
 
 
Sub Re8130368d6()
  Dim rTgt As Range
  Dim i As Long
  Set rTgt = Sheets("Sheet1").Range("A:A").SpecialCells(Type:=xlCellTypeConstants)
  If rTgt Is Nothing Then Exit Sub
  For i = 1 To rTgt.Areas.Count
    rTgt.Areas(i).Resize(, 6).Copy Destination:=Sheets("Sheet2").Cells(i * 7 - 6)
  Next i
  Set rTgt = Nothing
End Sub
 
 
列数に依存しない書き方もありますが、今回の課題には必要なさそうなので、
また別の機会にでも、検討してみてください。

投稿日時 - 2013-06-12 17:19:49

お礼

>馬鹿にしてます?(笑)
とんでもございません!尊敬しております!!

この度は大変お世話になりました(^^ゞ

投稿日時 - 2013-06-12 17:55:23

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.3

#1です。
Sheet1からSheet2 にコピーするのでしたか?
では、

Sub Re8130368d()
  Dim rTgt As Range
  Dim i As Long
  Set rTgt = Range("A:A").SpecialCells(Type:=xlCellTypeConstants)
  For i = 1 To rTgt.Areas.Count
    rTgt.Areas(i).Resize(, 4).Copy Destination:=Sheets("Sheet2").Cells(i * 5 - 4)
  Next i
  Set rTgt = Nothing
End Sub

投稿日時 - 2013-06-12 14:23:47

補足

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

できました!今までのマクロはコードを見た時に大体どのように実行されているのかなとわかったのですが、貴方様のコードはマクロ初心者の小生にはチンプンカンプンです(笑)流石です!

ちなみに列数を5列や6列にするにはどのように変数を与えてやればよいでしょうか?

投稿日時 - 2013-06-12 16:25:55

ANo.2

別件の続きのようですね。
数式を使っていないですし、列数固定ということなので、
簡単な方法が却って効率的です。

Sub Re8130368c()
  Dim rTgt As Range
  Dim i As Long
  Set rTgt = Range("A:A").SpecialCells(Type:=xlCellTypeConstants)
  For i = 2 To rTgt.Areas.Count
    rTgt.Areas(i).Resize(, 4).Cut Destination:=Cells(i * 5 - 4)
  Next i
  Set rTgt = Nothing
End Sub

投稿日時 - 2013-06-12 14:18:20

ANo.1

次のようなマクロでどうでしょう。

Sub 並び替え()
Set WS1 = Worksheets("Sheet1")
Set WS2 = Worksheets("Sheet2")
Dim i, n As Integer
i = 0
n = -4
Do
i = i + 1
If Left(WS1.Cells(i, "A"), 3) = "セット" Then
Setto1 = i
End If
Do
i = i + 1
If i > 500 Then Exit Do
Loop Until Left(WS1.Cells(i, "A"), 3) = "セット"
Setto2 = i - 1
Range(WS1.Cells(Setto1, "A"), Cells(Setto2, "D")).Copy
Do
n = n + 5
Loop Until WS2.Cells(1, n) = ""
ActiveSheet.Paste (WS2.Cells(1, n))
Application.CutCopyMode = False
i = i - 1
Loop Until i = 500
End Sub

投稿日時 - 2013-06-12 10:51:56

あなたにオススメの質問