| |
▼BON8021 さん 今晩は。
>もう１点教えて頂きたいのですが、マスターシートの値を更新した場合、
>転記用シートに反映させる手法はどうすれば、良いでしょうか。
>
>vlookup関数のようなイメージを想定しており、特にm列(単価に相当)の
>値がマスタ上で更新された場合、各転記用シートにm列の値を反映させたい
>と思っております。
Sheet2モジュールのみ下記のコードに置き換えてください。
改良版、dictionary版のどちらでも動きます。
===========================
Sheet2モジュール
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dic2 As Object
Dim 行 As Long
Dim vntA, vntK
Dim i As Long, LastR As Long
Dim r As Range
'
行 = Target.Row
If Target.Count > 1 Then Exit Sub
If (Target.Column - 1) * (Target.Column - 11) _
* (Target.Column - 13) <> 0 Then Exit Sub
If Cells(行, "A").Value = "" Then Exit Sub
If Cells(行, "K").Value = "" Then Exit Sub
'
LastR = Range("A65536").End(xlUp).Row
Set dic2 = CreateObject("Scripting.Dictionary")
vntA = Range("A2", Range("A" & LastR)).Value
vntK = Range("K2", Range("K" & LastR)).Value
For i = 1 To UBound(vntA)
If vntA(i, 1) <> "" And vntK(i, 1) <> "" Then
dic2(vntA(i, 1) & vntK(i, 1)) = dic2(vntA(i, 1) & vntK(i, 1)) + 1
End If
Next
'
Select Case Target.Column
Case 1, 11
If dic2(Cells(行, "A").Value & Cells(行, "K").Value) > 1 Then
MsgBox "重複"
Target.ClearContents
Target.Select
End If
Case 13
LastR = Sheets("Sheet1").Range("A65536").End(xlUp).Row
For Each r In Sheets("Sheet1").Range("A2", Sheets("Sheet1").Range("A" & LastR))
If (r.Value & r.Offset(0, 10).Value) = _
(Cells(行, "A").Value & Cells(行, "K").Value) Then
r.Offset(0, 12).Value = Target.Value
End If
Next
End Select
'
Set dic2 = Nothing
End Sub
|
|
kobasan
- 05/9/10(土) 19:35 -
