| |
▼ひろし さん：
こんにちは
出先のモバイル環境で、エクセルもないのでメモ帳に直接コードを書き込みました。
間違いがたくさんあるかもしれません。罫線のコード、自信がなかったのでkanabunさんの
コードをお借りしています。
最初の club=Array("バスケ部","野球 部","バレー部","テニス部")
ここで、クラブの種類と順序を規定します。規定のないのもは、１つにまとめられて
最後のブロックになります。
しかし、まったくテストもできないどころか、コンパイルもできませんので
さて、どうなりますか。
Option Explicit
Sub Sample()
Dim club as Variant
Dim dicV() As Object
Dim z As Long
Dim i As Long
Dim c As Range
Dim x As Variant
Application.ScreenUpdating = False
club=Array("バスケ部","野球 部","バレー部","テニス部")
z=Ubound(club)+2
redim dicV(1 to z)
For i = 1 To Z
Set dicV(i) = CreateObject("Scripting.Dictionary")
Next
With Sheets("Sheet1")
For Each c In .Range("A1",.Range("A" & .Rows.Count).End(xlUp))
x = Application.Match(c.Value,v,0)
If Not IsNumeric(x) then x=Ubound(dicV)
DicV(x)(c.Value) = c.Offset(,1).Value
Next
End With
z = 1
With Sheets("Sheet2")
.Cells.ClearContents
For i = 1 To Ubound(dicV)
If DicV(i).Count>0 Then
.Cells(z,1).Resize(DicV(i).Count).Value = _
Application.Transpose(Application.Transpose(DicV(i).Keys))
.Cells(z,2).Resize(DicV(i).Count).Value = _
Application.Transpose(Application.Transpose(DicV(i).Items))
.Cells(z,1).Resize(dicV(i).Count,2).BorderAround xlContinuous
z=z+divV(i).Count + 1
End If
Next
End With
For i = 1 To Ubound(DicV)
Set DicV(i) = Nothing
Next
Application.ScreenUpdating = True
End Sub
|
|
UO3
- 11/4/29(金) 18:46 -
