0 0 1 0 0 1・・・
a b c d e f ・・・
a b c d e f ・・・
a b c d e f ・・・


上図で一番上の行にある数字が1の場合だけの列を選択し、1の列全てをコピーをして
別シートへ移動して今度は、行で挿入をして貼り付けを行いたいと考えております。
しかし、データ量がものすごく多いので1だけがいくつあるのかさえわからないため
挿入先にも一体いくつ挿入すればいいかわかりません。

データ量(行が1の数)にあわせて挿入数をいれ、また列のデータから行のデータへの変換はどうすればいいかお力を貸していただけないでしょうか?


今回の質問はEXCELについてです。
そしてできればVBAのほうで処理を行いたいと思っております。
(原本のデータ編集が何度もされるのでVBAで登録しておこうかと^^;)
よろしくお願いいたします。

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

A 回答 (2件)

こんなのはどうでしょうか?


行列を入れ替えるのはPasteSpecialのTranspose=Trueでできると思います。
1列づつ入れ替えずに、まとめてコピーしています。
Private Sub sample()
Dim c As Integer
Dim rng As Range
For c = 1 To Cells(1, Columns.Count).End(xlToLeft).Column '1行目のデータを基準に、1列目から最後の列まで
If Cells(1, c) = 1 Then '1なら
'rngにunionで追加する.ただし最初(rngがnothing)の場合はunionがエラーになるので対処する
If rng Is Nothing Then '最初なら
Set rng = Columns(c) 'rngに列を設定
Else
Set rng = Union(rng, Columns(c)) 'rngに列を追加
End If
End If
Next
Set rng = Intersect(rng, ActiveSheet.UsedRange) 'データの最終行までの範囲をUsedRangeとの重なり(Intersect)で取得
rng.Copy 'コピー
Sheets("Sheet2").Range("A1").PasteSpecial Transpose:=True '行列を入れ替えて貼り付け
End Sub
    • good
    • 0
この回答へのお礼

すごいです!!できました。
本当に助かりました!ありがとうございます。

お礼日時:2009/05/14 16:40

下のコードはRange("データ最初のセル").End(xlToRight).Column


でデータの最終列を取得し、Forで処理をループさせる
1の場合のみ行全てを選択し、
コピー→シート2に移動し挿入後シート1に移動、
の繰り返しです。
処理が終わるまで動作はできません。

Private Sub Test()
Dim i, SCo As Integer
SCo = 1
For i = 1 To Range("A1").End(xlToRight).Column
If Cells(1, i) = 1 Then
If i >= 1 And i <= 256 Then
Range(Mid(Cells(1, i).Address, 2, InStr(Cells(1, i).Address, "1") - 3) + ":" + Mid(Cells(1, i).Address, 2, InStr(Cells(1, i).Address, "1") - 3)).Select
Selection.Copy
Sheets("Sheet2").Select
Range(Mid(Cells(1, SCo).Address, 2, InStr(Cells(1, SCo).Address, "1") - 3) + ":" + Mid(Cells(1, SCo).Address, 2, InStr(Cells(1, SCo).Address, "1") - 3)).Select
Selection.Insert Shift:=xlToRight
SCo = SCo + 1
Sheets("Sheet1").Select
Else
MsgBox "Error"
End If
End If
Next
End Sub
    • good
    • 0

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


人気Q&Aランキング

おすすめ情報