配列 リストの追加漏れを探す

Sub 不足リスト作成()

'***********************************************
'管理表シートにないabcd装置を追加作成
'***********************************************
Dim Ws As Worksheet
Dim Myabcd() As Variant
Set Ws = Sheets("2026")
Dim XX As Long
XX = Ws.Cells(Rows.Count, 7).End(xlUp).Row
'***********************************************
'管理表シートにある現abcdの配列
'***********************************************
 ReDim Myabcd((XX - 3) / 2)
    For i = 4 To XX Step 2
        Myabcd(i / 2 - 1) = Ws.Cells(i, 7).Value & "-" & Ws.Cells(i, 11).Value   'セルを配列に格納
    Next i
'***********************************************
'管理表シートにある現abcdの配列を連想配列にする
'***********************************************
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
Dim AA As Long
For AA = LBound(Myabcd) To UBound(Myabcd)
     myDic.Add Myabcd(AA), 1
Next AA
'***********************************************
'管理表シートに未登録装置を抽出すする
'***********************************************
Dim YY As Long
Dim arr() As String
Dim msg As String
Dim Yourabcd As Variant
Dim Ds As Worksheet  'abcdシートの全abcdリストから登録漏れを抽出
Set Ds = Sheets("japan")
YY = Ds.Cells(Rows.Count, 1).End(xlUp).Row
For AA = 2 To YY
 msg = "追加装置はありません"
 If Left(Ds.Cells(AA, 12), 4) = "abcd" Then
  Yourabcd = Ds.Cells(AA, 2).Value & "-" & Ds.Cells(AA, 12).Value
 If Not myDic.Exists(Yourabcd) Then
  msg = "追加装置があります"
  arr = Split(Yourabcd, "-")
   Ws.Cells(XX + 1, 7) = arr(0)
   Ws.Cells(XX + 2, 7) = arr(0)
   Ws.Cells(XX + 1, 11) = arr(1)
   Ws.Cells(XX + 2, 11) = arr(1)
   Ws.Cells(XX + 1, 12) = 1
   Ws.Cells(XX + 2, 12) = 2
   XX = XX + 2
 End If
 End If
Next AA

MsgBox msg

End Sub

配列 データ転記

Sub 管理表更新()
'***************************************
'集計シート、データシートの設定
'***************************************
Dim XX As Long, YY As Long
Set Mydata = Sheets("2026")
Set Yourdata = Sheets("japan")

 XX = Mydata.Cells(Rows.Count, 1).End(xlUp).Row
 YY = Yourdata.Cells(Rows.Count, 3).End(xlUp).Row
'***************************************
'データシート全体を連想配列Dictionaryを使って処理
'***************************************
Dim Yourdic As Object
Set Yourdic = CreateObject("Scripting.Dictionary")

Dim Dickey As String
Dim Dicitem As Long
Dim AA As Long, BB As Long
Dim Yoursmgp As String
Dim Num As Integer
For BB = 2 To YY
If Ds.Cells(BB, 22) <> 2 And Ds.Cells(BB, 22) <> 3 And _
   InStr(Ds.Cells(CC, 7), "smgp") > 0 Then
    Yoursmgp = StrConv(Mid(Ds.Cells(BB, 7), 11, 8), 1)
    Num = Int((Ds.Cells(BB, 8) - 1) / 8) + 1

    Dickey = Myedge.Cells(BB, 25).Value & "-" & Yoursmgp & "-" & Num
    Dicitem = Myedge.Cells(BB, 16).Value
        If Dicedge.Exists(Dickey) Then
             Dicedge(Dickey) = Dicedge(Dickey) + Dicitem
        Else
             Dicedge.Add Dickey, Dicitem
        End If
Next BB

'***************************************
'集計シートに結果を転記
'***************************************
Dim Targetkey As String
For AA = 11 To XX
 Targetkey = Mydata.Cells(AA, 7).Value & "-" & Val(Mydata.Cells(AA, 10).Value) & "-" & Val(Mydata.Cells(AA, 11).Value)
     If Dicedge.Exists(Targetkey) Then
      Mydata.Cells(AA, 17) = Dicedge(Targetkey)
     Else
       Mydata.Cells(AA, 17) = ""
    End If
Next AA

End Sub

配列（基礎実践）連想配列で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