エクセル 表の変換

エクセルで表の変換をしたのですが、実施方法をご教授お願いします。番号は1000個、機種は100程度あるので手作業では厳しいです。ピボットで実施しようとしましたがうまくいかなくて困っています。
■変換前
番号 機種A 機種B
あ 　　　　　 1
い 　1 　　　1
う 　　　1
え 　2 　　　1

■変換後
機種　　　番号　数量
機種A い 1
機種A え 2
機種B あ 1
機種B い 1
機種B う 1
機種B え 1

No.2 ベストアンサー 回答者： fujillin 回答日時： 2021/11/08 15:36

こんにちは

表中の値の入っているセルのみをピックアップするものと解釈しました。
（空白セルに見えるところは、実際にも空白であるものと仮定しています）
マクロでもできると思いますが、以下は関数での例です。

範囲が広いようなので、添付画面の都合上、列方向を縮めて機種は3種類にしてあります。
一応の対象範囲にしてある「$B$2:D$D1000」を修正することで、適用範囲は変更可能です。
（範囲の列数は100程度（＝3桁以下）であるものと仮定しています）
添付図では、並び替え後をG:I列に表示していますが、実際には別シートになるのかも知れませんね。

※ 関数で並び替えていますので、固定値にしたい場合はG:I列を選択しコピー、値をペーストすれば固定値にすることができます。
※ 対象範囲が広いと、全部を計算するのに若干の時間がかかるかもしれません。


添付図では、G2:I2にそれぞれ以下の式を入れて、下方にフィルコピーしてあります。
G2の式
=IFERROR(INDEX($1:$1,INT(AGGREGATE(15,6,ROW($B$2:$D$1000)+COLUMN($B$2:$D$1000)*1000/($B$2:$D$1000<>""),ROW(A1))/1000)),"")

H2の式
=IFERROR(INDEX($A:$A,MOD(AGGREGATE(15,6,ROW($B$2:$D$1000)+COLUMN($B$2:$D$1000)*1000/($B$2:$D$1000<>""),ROW(A1)),1000)),"")

I2の式
=IFERROR(OFFSET($A$1,MOD(AGGREGATE(15,6,ROW($B$2:$D$1000)+COLUMN($B$2:$D$1000)*1000/($B$2:$D$1000<>""),ROW(A1)),1000)-1,INT(AGGREGATE(15,6,ROW($B$2:$D$1000)+COLUMN($B$2:$D$1000)*1000/($B$2:$D$1000<>""),ROW(A1))/1000)-1),"")

この回答へのお礼

返事遅くなりすみません。教えていただきありがとございます。

お礼日時：2021/11/14 11:55

No.3 回答者： bonaron 回答日時： 2021/11/11 12:16

VBA で ADO を使用した例です。

Sub Sample_01()
Const SH_BEFORE = "変換前"
Dim dbCon As Object
Dim dbRst As Object
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim strSQL As String
Dim fld As String
Dim tbl As String
Dim CCnt As Long
Dim i As Long

'出力用シートを準備
Set ws1 = Worksheets(SH_BEFORE)
Worksheets.Add After:=ws1
On Error Resume Next
ActiveSheet.Name = "変換後"
On Error GoTo 0
Range("A1:C1").Value = Split("機種,番号,数量", ",")
Set ws2 = ActiveSheet

' Connection生成
Set dbCon = CreateObject("ADODB.Connection")
Set dbRst = CreateObject("ADODB.Recordset")
With dbCon
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Extended Properties") = "Excel 12.0"
.Open ThisWorkbook.FullName
End With

CCnt = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
tbl = "[" & SH_BEFORE & "$]"

For i = 2 To CCnt
' SQL文作成
fld = ws1.Cells(1, i)
strSQL = "SELECT '" & fld & "' as 機種, [番号],[" & fld & "] FROM " & tbl & _
" Where " & tbl & ".[" & fld & "] Is Not Null "

' Recordset を開く
dbRst.Open strSQL, dbCon, 0, 3 ' adOpenForwardOnly, adLockOptimistic
' 変換後 に貼り付け
ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1).CopyFromRecordset dbRst
dbRst.Close
Next

Set dbRst = Nothing
dbCon.Close: Set dbCon = Nothing
End Sub

No.1 回答者： mygoonickname 回答日時： 2021/11/08 12:19

こんにちは。

フィルターで、抽出後にコピーされては、どうでしょうか？

フィルターを掛けて、機種Aで、空白以外を選択。
結果を、番号から機種Aまでをコピーして、別シートへ貼り付け。
機種Aの右側の空欄に、先頭から最後まで範囲を選んで、機種Aと入力。
入力状態のままCtrl ＋ Enterで一括入力。
番号と、数字、機種Aという感じにできるかと。

上記と同じ様に、機種Bで、空白以外。にして、番号から機種Bまでを
コピーして、別シートへ貼り付け。機種Aの列を削除。

後は、列を変換後の順に変更すれば、どうでしょうか？