セル データを項目別に変数に格納する
※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。
※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。
Sub ExcelReDimPreserve() '************************************* 'セル データを項目別に変数に格納する '************************************* Dim sht As Worksheet, strCat() As String Dim i As Long, Newstr As String, j As Long Dim Oldstr As String, CellData() As String Dim cntData As Long, cntCat As Long, ttl() As Long Set sht = ThisWorkbook.Worksheets("SubIndex") Oldstr = "" j = 0 With sht ExcelSort '事前に並べ替え cntData = .Cells(65536, 1).End(xlUp).Row ReDim CellData(cntData, 3) As String '見出しが無いデータと仮定 For i = 1 To cntData Newstr = Trim(.Cells(i, 3).Value) If Oldstr <> Newstr Then j = j + 1 ReDim Preserve strCat(j) As String ReDim Preserve ttl(j) As Long strCat(j) = Newstr Oldstr = Newstr CellData(i, 0) = j CellData(i, 1) = .Cells(i, 2).Value CellData(i, 2) = .Cells(i, 3).Value CellData(i, 3) = .Cells(i, 4).Value ttl(j) = ttl(j) + 1 Else CellData(i, 0) = j CellData(i, 1) = .Cells(i, 2).Value CellData(i, 2) = .Cells(i, 3).Value CellData(i, 3) = .Cells(i, 4).Value ttl(j) = ttl(j) + 1 End If Next i End With For cntCat = 1 To j Debug.Print cntCat & " " & strCat(cntCat) & " (" & ttl(cntCat) & ")" For i = 1 To cntData If CellData(i, 0) = cntCat Then Debug.Print " " & CellData(i, 3) & " " & CellData(i, 1) End If Next i Next cntCat End Sub |