セル データを項目別に変数に格納する

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][セル データを項目別に変数に格納する]
Option Explicit


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





Production Japan Import Application. Since 1998