例文を使って繰り返し業務を時短

【マクロ・VBA】縦(行)ループしてキーとアイテムを抽出して新規シートに転記する

エクセル、マクロ、VBAでループしてキーとアイテムを抽出して新規シートに転記する VBA

配列の説明

配列は複数の値を一つの変数に格納することができます。配列は、次のように宣言することができます。

Dim myVal(5) As Integer

この例では、myValという名前の整数型の配列を宣言しています。配列のサイズは5であり、整数型の値を格納できます。

配列に値を格納するには、次のようにインデックス番号を指定してアクセスします。

myVal(0) = 10
myVal(1) = 20
myVal(2) = 30
myVal(3) = 40
myVal(4) = 50

この例では、配列myValの最初の要素に10を、2番目の要素に20を、3番目の要素に30を、4番目の要素に40を、5番目の要素に50を格納しています。

配列の要素をループして処理する場合は、ForループやForEachループを使用できます。以下は、Forループを使用して配列の要素を合計する例です。

Dim i As Integer
Dim sum As Integer

For i = 0 To UBound(myVal)
    sum = sum + myVal(i)
Next i

MsgBox "配列の合計は" & sum & "です。"

この例では、Forループを使用して配列myValの要素をループし、sum変数に合計値を計算しています。ループのために、配列の上限値を取得するためにUBound関数を使用しています。

また、配列の宣言と同時に値を格納することもできます。次のように、配列myValを宣言し、値を格納する例を示します。

Dim myVal As Variant
myVal = Array(10, 20, 30, 40, 50)

この例では、myValという名前の配列を宣言し、Array関数を使用して値を格納しています。配列のサイズは自動的に決定されます。

配列は、VBAで非常に重要な概念であり、多くのプログラムで使用されます。配列をうまく使うことで、コードを簡潔にし、処理速度を向上させることができます。

キーとアイテムを抽出して新規シートに転記

Sub キーとアイテムを抽出して新規シートに転記() 
  Dim myDic As Object, myKey, myItem
  Dim myVal, myVal2, myVal3
  Dim i As Long
  
    'Range("E2", Range("G" & Rows.count).End(xlUp)).ClearContents
    'Range("E1:G1").Value = Range("A1:C1").Value
    
    '元データを配列に格納
    Set myDic = CreateObject("Scripting.Dictionary")
    'myDicへデータを格納
    myVal = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
    
        For i = 1 To UBound(myVal, 1)
        
            myVal2 = myVal(i, 1) & "_" & myVal(i, 2)
            If Not myVal2 = "_" Then
                If Not myDic.Exists(myVal2) Then
                    myDic.Add myVal2, myVal(i, 3)
                Else
                    myDic(myVal2) = myDic(myVal2) + myVal(i, 3)
                End If
            End If
        Next
        
        
    Worksheets.Add(After:=ActiveSheet.Next).Name = ActiveSheet.Name & "_作成" & VBA.Format(Now(), "h時mm分ss秒")
    'Worksheets.Add
    'ActiveSheet.Name = "output"
        
        
    ' ---Key,Itemの書き出し
    myKey = myDic.Keys
    myItem = myDic.Items
        For i = 0 To UBound(myKey)
            myVal3 = Split(myKey(i), "_")
            Cells(i + 2, 1).Value = myVal3(0)
            Cells(i + 2, 2).Value = myVal3(1)
            Cells(i + 2, 3).Value = myItem(i)
        Next
        
    Set myDic = Nothing
    
MsgBox "転記完了"
End Sub

解説

  • Dim myDic As Object, myKey, myItem:Object型のmyDicと、myDicのキーとアイテムを格納するための変数myKey、myItemを宣言しています。
  • Dim myVal, myVal2, myVal3:元データの配列myValと、その配列内の値を格納するためのmyVal2、myVal3を宣言しています。
  • Set myDic = CreateObject("Scripting.Dictionary"):myDicを辞書オブジェクトとして作成します。
  • myVal = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value:元データの範囲を配列myValに格納します。
  • myVal2 = myVal(i, 1) & "_" & myVal(i, 2):myVal2には、myValの1列目と2列目の値を”_”でつないだ文字列が格納されます。
  • If Not myVal2 = "_" Then:myVal2が”_”でない場合に実行される条件分岐。

コメント

タイトルとURLをコピーしました