Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


28540 / 76732 ←次へ | 前へ→

【53488】Re:条件が一致したもののコピーについて
回答  Sasurai  - 08/1/16(水) 20:58 -

引用なし
パスワード
   今回は解説付きです。前回と変わったところを比較すれば、だいたい
いじるところが分かってくると思います。
勉強してみてください。

Sub sample()
 Dim dic As Object
 Dim endRow As Long
 Dim i As Long, j As Long
 Dim v1(), v2(), v3()
 
 With ThisWorkbook.Worksheets("Sheet1")
  'Sheet1のJ列の最終行を取得
  endRow = .Cells(.Rows.Count, "J").End(xlUp).Row
  'Sheet1の製造番号を配列v1へ格納
  v1() = .Range("J3:J" & endRow).Value
  'Sheet1のメモを配列v2へ格納
  v2() = .Range("FG3:IV" & endRow).Value 
 End With
 
 '配列v1をループし辞書を作成する
 Set dic = CreateObject("Scripting.Dictionary")
 For i = 1 To endRow
  '製造番号に対応するメモの行を一旦、辞書に登録
  If Not dic.exists(v1(i, 1)) Then
   dic(v1(i, 1)) = i
  End If
 Next i
 
 With ThisWorkbook.Worksheets("Sheet2")
  'Sheet2のJ列の最終行を取得
  endRow = .Cells(.Rows.Count, "J").End(xlUp).Row
  'Sheet2の製造番号を配列v1へ格納
  v1() = .Range("J3:J" & endRow).Value
  'v3の配列サイズを決める    
  ReDim v3(1 To endRow, 1 To UBound(v2, 2))
  '配列v1をループし、製造番号に対応するメモを配列v3へ格納    
  For i = 1 To endRow  
   If dic.exists(v1(i, 1)) Then
    For j = 1 To UBound(v3, 2)
     v3(i, j) = v2(dic(v1(i, 1)), j)
    Next j
   End If
  Next i
  '配列v3をシートに出力する
  .Range("FG3").Resize(endRow, UBound(v3, 2)).Value = v3()
 End With
 '配列クリア
 Erase v1, v2, v3
 'オブジェクト解放
 Set dic = Nothing
End Sub

0 hits

【53471】条件が一致したもののコピーについて tantan 08/1/15(火) 19:47 質問
【53473】Re:条件が一致したもののコピーについて ハチ 08/1/15(火) 21:29 発言
【53477】Re:条件が一致したもののコピーについて Sasurai 08/1/16(水) 1:03 回答
【53487】Re:条件が一致したもののコピーについて tantan 08/1/16(水) 19:02 質問
【53488】Re:条件が一致したもののコピーについて Sasurai 08/1/16(水) 20:58 回答
【53489】Re:条件が一致したもののコピーについて Sasurai 08/1/16(水) 21:19 回答
【53497】Re:条件が一致したもののコピーについて tantan 08/1/17(木) 12:49 質問
【53498】Re:条件が一致したもののコピーについて neptune 08/1/17(木) 15:36 回答
【53500】Re:条件が一致したもののコピーについて tantan 08/1/17(木) 21:29 お礼
【53499】Re:条件が一致したもののコピーについて Sasurai 08/1/17(木) 15:45 回答
【53501】Re:条件が一致したもののコピーについて tantan 08/1/17(木) 21:43 お礼

28540 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free