Excel VBA質問箱 IV

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

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


5697 / 76732 ←次へ | 前へ→

【76642】Re:複数のシートの転記について
発言  マナ  - 15/2/22(日) 16:02 -

引用なし
パスワード
   修正し再投稿

Sub test()
  Dim dic As Object
  Dim s As String
  Dim ws As Worksheet
  Dim r As Long
  Dim v
  Dim i As Long
  Dim c As Range
  Dim idx As Long
   
  Set dic = CreateObject("Scripting.Dictionary")
  
  For Each ws In Worksheets
  
    If ws.Name Like "*単価" Then
      
      v = ws.Range("A1").CurrentRegion.Value
      
      For i = 2 To UBound(v)
        dic(v(i, 2)) = Array(v(i, 3), v(i, 4), v(i, 5))
      Next
      
      s = Left(ws.Name, 6)
      r = Worksheets(s).Range("C" & Rows.Count).End(xlUp).Row
      
      For Each c In Worksheets(s).Range("C4:C" & r)
        If dic.exists(c.Value) Then
          c.Offset(, 1).Resize(, 3).Value = dic(c.Value)
        End If
      Next
    End If
  Next
 
End Sub

273 hits

【76641】複数のシートの転記について ももかん 15/2/22(日) 14:28 質問[未読]
【76642】Re:複数のシートの転記について マナ 15/2/22(日) 16:02 発言[未読]
【76644】Re:複数のシートの転記について マナ 15/2/22(日) 16:49 発言[未読]
【76651】Re:複数のシートの転記について マナ 15/2/23(月) 22:31 発言[未読]
【76646】Re:複数のシートの転記について β 15/2/22(日) 17:25 発言[未読]
【76657】Re:複数のシートの転記について ももかん 15/2/24(火) 12:09 お礼[未読]

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