| 
    
     |  | こんにちは。かみちゃん です。 
 > 特殊な行列の入れ替えをしたい
 
 私は、以下のような感じでしています。
 
 Sub Sample()
 SpecialTranspose Range("A1:A4"), Range("C1")
 End Sub
 
 Function SpecialTranspose(rng1 As Range, rng2 As Range, Optional bln As Boolean = False)
 Dim v As Variant
 Dim vv As Variant
 Dim x As Long, y As Long, xx As Long, yy As Long, yyy As Long
 
 v = rng1.Value
 xx = UBound(v, 2)
 yy = UBound(v, 1)
 ReDim vv(1 To xx, 1 To yy)
 For x = 1 To xx
 yyy = 0
 For y = yy To 1 Step -1
 yyy = yyy + 1
 vv(x, yyy) = v(y, x)
 Next
 Next
 
 If bln Then
 rng1.ClearContents
 End If
 rng2.Cells(1, 1).Resize(xx, yy).Value = vv
 End Function
 
 上記のうち、
 
 SpecialTranspose Range("A1:A4"), Range("C1")
 
 は、
 
 Range("A1:A4") は、入れ替え元セル範囲
 Range("C1") は、入れ替え先の左上のセル
 ※Range("A1"), True とすると、入れ替え元を消去して、同じ位置に入れ替えます。
 
 いろいろ試してみてください。
 
 
 |  |