配列（基礎実践）連想配列でSUMIF

Sub 連想配列SUMIF()
'************事前準備*******************
'参照設定：Microsoft Scripting Runtime
'***************************************

'***************************************
'集計シート、データシートの設定
'***************************************
Dim XX As Long, YY As Long
Set Smg = Sheets("Sheet2")
Set Myedge = Sheets("Sheet1")

 XX = Smg.Cells(Rows.Count, 1).End(xlUp).Row
 YY = Myedge.Cells(Rows.Count, 1).End(xlUp).Row
'***************************************
'データシート全体を連想配列Dictionaryを使って処理
'***************************************

'参照設定：Microsoft Scripting Runtime を設定しない場合は右コメントに変更
Dim Dicedge As Dictionary       'Dim Dicedge As Object
Set Dicedge = New Dictionary    'Set Dicedge = CreateObject("Scripting.Dictionary")

Dim Edgekey As String
Dim Edgesuu As Long
Dim AA As Long, BB As Long

 
For BB = 2 To YY
  Edgekey = Myedge.Cells(BB, 1)
  Edgesuu = Myedge.Cells(BB, 4)
  If Dicedge.Exists(Edgekey) Then
      Dicedge(Edgekey) = Dicedge(Edgekey) + Edgesuu
  Else
     Dicedge.Add Edgekey, Edgesuu
  End If
Next BB

'***************************************
'集計シートに結果を転記
'***************************************
Dim Targetkey As String
For AA = 11 To XX
 Targetkey = Smg.Cells(AA, 1).Value
     If Dicedge.Exists(Targetkey) Then
      Smg.Cells(AA, 8) = Dicedge(Targetkey)
     Else
       Smg.Cells(AA, 8) = ""
    End If
Next AA

End Sub

配列（基礎実践）参照設定をしない連想配列Currentregionを使う

Sub 参照設定をしない連想配列Currentregionを使う()

'***************************************
'タイマーをセット
'***************************************
Dim startTime As Single, endTime As Single
    startTime = Timer
'***************************************
'Keyになる集計表の列を配列に格納
'***************************************
Dim XX As Long
Dim arrSyukei As Variant
Set Smg = Sheets("Sheet2")
Set Myedge = Sheets("Sheet1")

 XX = Smg.Cells(Rows.Count, 1).End(xlUp).Row
arrSyukei = Smg.Range("A11:A" & XX).Value

'***************************************
'データシート全体を配列に格納
'***************************************
Dim YY As Long
Dim arrEdge As Variant
 YY = Myedge.Cells(Rows.Count, 1).End(xlUp).Row
 '注意　データ範囲内を指定すること
arrEdge = Myedge.Range("A2").CurrentRegion.Value
 
'***************************************
'連想配列を使って処理
'***************************************
Dim arrHit() As Variant
ReDim arrHit(1 To UBound(arrSyukei), 1 To 1)

Dim Dicedge As Object
Set Dicedge = CreateObject("Scripting.Dictionary")
Dim AA As Long, BB As Long

For BB = LBound(arrEdge) To UBound(arrEdge)
  Dicedge.Add arrEdge(BB, 1), arrEdge(BB, 2) 'keyにする列、出力したい列
Next BB

Dim Syukeikey As Variant

For AA = LBound(arrSyukei) To UBound(arrSyukei)
 Syukeikey = arrSyukei(AA, 1)    'keyで結び付ける
 If Dicedge.Exists(Syukeikey) Then
 arrHit(AA, 1) = Dicedge(Syukeikey)
 Else
 arrHit(AA, 1) = ""
 End If
Next AA

'***************************************
'連想配列の要素を集計表に転記
'***************************************
Smg.Range("G11:G" & XX) = arrHit    '出力する列

'***************************************
'処理時間を表示
'***************************************
endTime = Timer
    MsgBox endTime - startTime
    
End Sub

配列（基礎実践）参照設定：Microsoft Scripting Runtime連想配列範囲を指定で使う

Sub 連想配列そのまま使える()
'参照設定：Microsoft Scripting Runtime
'タイマーをセット
Dim startTime As Single, endTime As Single
    startTime = Timer
'集計表のホスト名を配列に格納
Dim XX As Long
Dim arrSyukei As Variant
Set Smg = Sheets("Sheet2")
Set Myedge = Sheets("Sheet1")

 XX = Smg.Cells(Rows.Count, 1).End(xlUp).Row
arrSyukei = Smg.Range("A11:A" & XX).Value  'sseiホスト名

'エッジ情報全体を配列に格納
Dim YY As Long
Dim arrEdge() As Variant
 YY = Myedge.Cells(Rows.Count, 1).End(xlUp).Row
 ReDim arrEdge(YY, 20)
arrEdge = Myedge.Range(Myedge.Cells(2, 1), Myedge.Cells(YY, 20)).Value
 
 
Dim arrHit() As Variant
ReDim arrHit(1 To UBound(arrSyukei), 1 To 1)

Dim Dicedge As Dictionary
Set Dicedge = New Dictionary
Dim AA As Long, BB As Long

For BB = LBound(arrEdge) To UBound(arrEdge)
  Dicedge.Add arrEdge(BB, 1), arrEdge(BB, 2)
Next BB

Dim Syukeikey As Variant

For AA = LBound(arrSyukei) To UBound(arrSyukei)
 Syukeikey = arrSyukei(AA, 1)
 If Dicedge.Exists(Syukeikey) Then
 arrHit(AA, 1) = Dicedge(Syukeikey)
 Else
 arrHit(AA, 1) = ""
 End If
Next AA

Smg.Range("F11:F" & XX) = arrHit
 '処理時間
endTime = Timer
    MsgBox endTime - startTime
End Sub

配列（基礎実践）参照設定：Microsoft Scripting Runtime連想配列Currentregionを使う

Sub 連想配列Currentregionを使う()
'************事前準備*******************
'参照設定：Microsoft Scripting Runtime
'***************************************

'***************************************
'タイマーをセット
'***************************************
Dim startTime As Single, endTime As Single
    startTime = Timer
'***************************************
'Keyになる集計表の列を配列に格納
'***************************************
Dim XX As Long
Dim arrSyukei As Variant
Set Smg = Sheets("Sheet2")
Set Myedge = Sheets("Sheet1")

 XX = Smg.Cells(Rows.Count, 1).End(xlUp).Row
arrSyukei = Smg.Range("A11:A" & XX).Value

'***************************************
'データシート全体を配列に格納
'***************************************
Dim YY As Long
Dim arrEdge As Variant
 YY = Myedge.Cells(Rows.Count, 1).End(xlUp).Row
 '注意　データ範囲内を指定すること
arrEdge = Myedge.Range("A2").CurrentRegion.Value
 
'***************************************
'連想配列Dictionaryを使って処理
'***************************************
Dim arrHit() As Variant
ReDim arrHit(1 To UBound(arrSyukei), 1 To 1)

Dim Dicedge As Dictionary
Set Dicedge = New Dictionary
Dim AA As Long, BB As Long

For BB = LBound(arrEdge) To UBound(arrEdge)
  Dicedge.Add arrEdge(BB, 1), arrEdge(BB, 2) 'keyにする列、出力したい列
Next BB

Dim Syukeikey As Variant

For AA = LBound(arrSyukei) To UBound(arrSyukei)
 Syukeikey = arrSyukei(AA, 1)    'keyで結び付ける
 If Dicedge.Exists(Syukeikey) Then
 arrHit(AA, 1) = Dicedge(Syukeikey)
 Else
 arrHit(AA, 1) = ""
 End If
Next AA

'***************************************
'連想配列の要素を集計表に転記
'***************************************
Smg.Range("E11:E" & XX) = arrHit    '出力する列

'***************************************
'処理時間を表示
'***************************************
endTime = Timer
    MsgBox endTime - startTime
    
End Sub

配列（基礎実践）ForNextによる処理

Sub ForNextによる処理()
'タイマーをセット
Dim startTime As Single, endTime As Single
    startTime = Timer

'集計表のホスト名を配列に格納
Dim XX As Long
Dim arrSyukei As Variant
Set Smg = Sheets("Sheet2")
Set Myedge = Sheets("Sheet1")

 XX = Smg.Cells(Rows.Count, 1).End(xlUp).Row
arrSyukei = Smg.Range("A11:A" & XX).Value  'sseiホスト名

'エッジ情報を配列にホスト名とエッジNo.を格納
Dim YY As Long
Dim arrEdge As Variant
 YY = Myedge.Cells(Rows.Count, 1).End(xlUp).Row
arrEdge = Myedge.Range("A2:B" & YY).Value
 
 
Dim arrHit() As Variant
ReDim arrHit(1 To UBound(arrSyukei), 1 To 1)

Dim AA As Long, BB As Long
For AA = LBound(arrSyukei) To UBound(arrSyukei)
 arrHit(AA, 1) = ""
For BB = LBound(arrEdge) To UBound(arrEdge)
 If arrSyukei(AA, 1) = arrEdge(BB, 1) Then
 arrHit(AA, 1) = arrEdge(BB, 2)
 Exit For
 End If
Next BB
Next AA
Smg.Range("C11:C" & XX) = arrHit

'処理時間
endTime = Timer
    MsgBox endTime - startTime
End Sub

並び替え

Sub 並び替え()
Dim XX As Long

If Ws.FilterMode = True Then
Ws.ShowAllData
End If
 XX = Ws.Cells(Rows.Count, 3).End(xlUp).Row
  
Ws.Rows("4:" & XX).Select
    With Ws.Sort
        With .SortFields
            .Clear
            .Add Key:=Ws.Range("A5"), Order:=xlAscending
            .Add Key:=Ws.Range("B5"), Order:=xlAscending
            .Add Key:=Ws.Range("E5"), Order:=xlAscending
        End With
        .SetRange Ws.Range("A4:BW" & XX)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
Ws.Range("A5").Select
 
End Sub

オートフィルタ抽出データを別シートにコピー

Sub オートフィルタ抽出データを別シートにコピー()

Dim Sh1 As Worksheet
Dim Sh2 As Worksheet

    'シートを変数へ格納
    Set Sh1 = Sheets("2025")
    Set Sh2 = Sheets("勝")

    'フィルターでデータ抽出
    Sh1.Range("A2").AutoFilter 2, "勝"

    'フィルター抽出結果を別シートへ転記
    Sh1.Range("A1").CurrentRegion.Copy Sh2.Range("A1")

Sh1.Range("A2").AutoFilter

End Sub