TEST

Sub Macro1()

‘ Macro1 Macro


Dim title, question As String
Dim rownum, colnum, lastnum As Long
Dim org, trgt As Worksheet
Dim i, k As Integer

Set org = Worksheets(“元データ”)
Set trgt = Worksheets(“test”)
k = 2 ‘ 貼り付け先用 (ラベル用に1行開けている)
‘header = 3 ‘ ヘッダー数指定
org.Select
lastnum = Cells(Rows.Count, 1).End(xlUp).Row ‘ 最終行数取得

For i = 1 To lastnum ‘ 行数分ループ
org.Select
If InStr(Cells(i, 1), “[“) > 0 Then
question = Mid(Cells(i, 1), InStr(Cells(i, 1), “[“) + 1, InStr(Cells(i, 1), “]”) – InStr(Cells(i, 1), “[“) – 1) ‘ 設問番号取得
title = Mid(Cells(i, 1), 1, InStr(Cells(i, 1), “[“) – 1) ‘ 設問名取得
rownum = Cells(i, 2).End(xlDown).Row
colnum = Cells(rownum, Columns.Count).End(xlToLeft).Column – 1 ‘ 設問数(列)数取得。
Range(Cells(rownum, 2), Cells(rownum + 2, colnum + 1)).Copy ‘ 回答取得

trgt.Select
Range(Cells(k, 1), Cells(k – 1 + colnum, 1)).Value = question ‘ 設問番号貼り付け
Range(Cells(k, 2), Cells(k – 1 + colnum, 2)).Value = title ‘ 設問名貼り付け
Cells(k, 3).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True ‘ 回答貼り付け
k = k + colnum
End If
Next
End Sub

クロス集計をテーブルデータに

シェアする

  • このエントリーをはてなブックマークに追加

フォローする