ここから本文です

エクセルVBAの質問です。画像のとおり、行を列に並び替えるプログラムを教えてくだ...

アバター

ID非公開さん

2017/8/1917:24:34

エクセルVBAの質問です。画像のとおり、行を列に並び替えるプログラムを教えてください。行ごとの全組み合わせ(2セル1組)をA列とB列の2列に配置するという内容です。組み合わせが同じであ

っても、配置の列が相違する場合は別の組み合わせとして考えます。よろしくお願いします。

組み合わせ,Dim i As Long,エクセルVBA,lngR2,r As Range,c As Long,r.Cells

この質問は、活躍中のチエリアン・専門家に回答をリクエストしました。

閲覧数:
95
回答数:
2
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

sk_********さん

編集あり2017/8/1920:28:25

一つの例ですが。こんな感じですか。
・該当するシート(Sheet1)をアクティブにしてマクロを実行してください
・該当するシート(Sheet1)のA列~B列以上にデータが入っているものとします
・結果はSheet2に表示されます。(Sheet2がない場合はエラーになります)

Sub Sample()
Dim i As Long, r As Range, c As Long, v As Variant
With Sheet2
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
Set r = Range(Cells(i, 1), Cells(i, Columns.Count).End(xlToLeft))
v = MK_List(r)
.Range(.Cells(c + 1, 1), .Cells(UBound(v, 1) + c, 2)).Value = v
c = c + UBound(v, 1)
Next
End With
End Sub

Private Function MK_List(r As Range) As Variant
Dim i As Long, j As Long, c As Long, lngR1 As Long, lngR2
c = r.Columns.Count
If c = 1 Then Exit Function
ReDim v(1 To (c - 1) * c, 1 To 2) As Variant
For i = 1 To c
For j = 1 To c - 1
lngR1 = lngR1 + 1
v(lngR1, 1) = r.Cells(1, i)
Next
For j = 1 To c
If i <> j Then
lngR2 = lngR2 + 1
v(lngR2, 2) = r.Cells(1, j)
End If
Next
Next
MK_List = v
End Function

一つの例ですが。こんな感じですか。
・該当するシート(Sheet1)をアクティブにしてマクロを実行してください...

アバター

質問した人からのコメント

2017/8/22 17:43:11

処理速度がとても速くイメージ通りの配置変換ができました!大変助かりました、ありがとうございました!

またnaviさんもありがとうございました!

ベストアンサー以外の回答

1〜1件/1件中

web********さん

2017/8/1918:05:17

行列入れ替えならTRANSPOSE関数
http://www.relief.jp/docs/002499.html

なんだけど

質問内容は行列の入れ替えって意味じゃないよね

馬単組み合わせって感じかな
http://www.gizcollabo.jp/vbtomo/log/archive/choshoqa_16769_0.html

このあたりが参考になれば

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる