読者です 読者をやめる 読者になる 読者になる

世界の切りとり方

冷たい荒野を飼う

シベリア鉄道旅行記 更新中です。

Excel表の行列集約

VBA
n A B C
1  
2  
3

この表を

1 A
1 C
2 B
2 C
3 A
3 B
3 C

こういう風に整形

Option Base 1
Sub hogehoge()
  Dim i&, j&, result(), oldUbound
  Redim result(3, 1)
  With Selection
    For i=2 to .Rows.Count
      For j=2 to .Columns.Count
        If .Cells(i,j) <> "" then
          oldUbound=Ubound(result,2)
          Redim Preserve result(3, oldUbound+1)
          result(1,oldUbound)=.Cells(i,1)
          result(2,oldUbound)=.Cells(1,j)
          result(3,oldUbound)=.Cells(i,j)
        end if
      Next
    Next
  End With
  Workbooks.Add
  ActiveSheet.Range(Cells(1,1),Cells(Ubound(result,2), Ubound(result)) = WorkSheetFunction.Transpose(result)
End Sub

こんなのでも一発で書けるとちょっと楽しい。