Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

5693 / 76732

←次へ　｜　前へ→


	【76646】Re:複数のシートの転記について

β - 15/2/22(日) 17:25 -


	引用なし

	パスワード

▼ももかんさん：

すでにマナさんから模範解答がでていますので変化球です。

Sub Test()
　　Dim mSh As Worksheet
　　Dim pSh As Worksheet
　　Dim mList As Range
　　Dim pList As Range
　　
　　For Each mSh In Worksheets
　　　　If Not mSh.Name Like "*単価" Then　 '月シート
　　　　　　Set pSh = Nothing
　　　　　　On Error Resume Next
　　　　　　Set pSh = Sheets(mSh.Name & "単価")
　　　　　　On Error GoTo 0
　　　　　　If Not pSh Is Nothing Then　　　　　'単価シートあり
　　　　　　　　Set mList = mSh.Range("C4", mSh.Range("C" & Rows.Count).End(xlUp)).Offset(, 1).Resize(, 3)
　　　　　　　　With pSh.Range("A1").CurrentRegion
　　　　　　　　　　Set pList = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
　　　　　　　　End With
　　　　　　　　mList.Formula = "=IF($C4="""","""",VLOOKUP($C4,'" & pSh.Name & "'!" & pList.Address & ",COLUMN(B1),FALSE))"
　　　　　　　　mList.Value = mList.Value
　　　　　　End If
　　　　End If
　　Next
　　　　　　
End Sub

268 hits

▼

【76641】複数のシートの転記について ももかん 15/2/22(日) 14:28