| |
こんにちは。かみちゃん です。
>>>>>VBAの大先輩の皆さん
>
>敬意を表する意味合いで書いているのですが。
>あまり気になさらないでください。
長く引っ張るつもりは、ありませんが、ここの掲示板については、そのようなご配慮は特に必要ないと思います。
先輩とか後輩では、なく、助け合いですから。。。そういう敬意があると、かえって、構えてしまいます。
まぁ、この部分は、このあたりに終わりにしましょう。
>>内訳明細シートが複数あるのですか？
>>初めて聞いたような気がします。
>いえいえ内訳明細は１シートのみです。
>そんな書込ありましたか？
kazuoさんご自身が提示された以下のコードの意味をご理解されているのでしょうか？
For Each ws In ThisWorkbook.Worksheets
If InStr(1, ws.Name, "内訳明細") <> 0 Then
このコードの記述から想定して、おたずねしました。
>コード動作確認の結果をお伝えいたします。
>まず
>> Set rngFind = Sheets("Sheet2").Range("A1", Sheets("Sheet2").Range("A65536").End(xlUp))
>ここで実行時エラー９でインデックスが有効範囲にありませんと出ました。
>これについてはsheet2の部分を"商品マスター"に変更し解決しました。
申し訳ありません。前提条件の提示がもれていました。
Sheet2は、Sheet5のことです。
Sheet5が本当は「商品マスター」というシート名なら、それで「商品マスター」にしてください。
>次に"L1"に"一般"と書込帳票作成実施・結果はE列の単価のみ表示されます
>sheet5の商品マスターD列の値です。
>（C列は表示されずです呼称の部分です）
>相談ですが機能的に前の仕様が原因で問題（C列に入らない）だとすれば
>機能を残していただきたいのは単純に"式"と入れたらセル1つ飛びと
>一番最後のコードの部分↓ココだけでよいのです
申し訳ありません。
> C列とE列に呼称・単価を記入したいのです。
この仕様を見落としていて、E列の単価の判断のみにばかり気にしていました。
ただ、単価がきちんと反映できているのであれば、それがどこでできているのか・・・・
> Select Case Range("L1").Value
> Case "一般"
> .Offset(, 3).Value = c.Offset(, 3).Value
> Case "同業"
> .Offset(, 3).Value = c.Offset(, 4).Value
> Case "特別"
> .Offset(, 3).Value = c.Offset(, 5).Value
> Case Else
> MsgBox "単価種別が違います [" & Range("L1").Value & "]"
> End Select
という部分で行っているということはおわかりいただけましたでしょうか？
単価の設定は、
.Offset(, 3).Value = c.Offset(, 3).Value
のコードですから、
呼称もということでしたら、
.Offset(, 1).Value = c.Offset(, 2).Value
も追加するといいということになります。
ここが応用になります。
>追記：やはり前の仕様が原因ではないかと思う動作をします。
> 一度入力済みのA,B列記入したものは"ｍ"or"個"など表示されます
> A,B列が新規入力の場合C列"ｍ"等入力されません。
> 呼称についてもsheet5商品ﾏｽﾀｰから引っ張ってくる方がよいかと
> 思いますので、いかがでしょうか。
前の仕様が原因というわけではないので、そのままにしておきます。
前の仕様のうち、一度入力済みのものは、「商品マスター」から参照してくるのではなく、入力済みの値を常に参照するようにするということでいいですよね？
その仕様であれば、以下のよなコードに修正してください。
◆部分が修正箇所です。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim hinmei As String, keijyou As String
Dim myRange As Range
Dim endRow As Long
Dim a As Variant
Dim i As Variant
Dim c As Range '★
Dim FirstAddress As String '★
Dim rngFind As Range '★
Dim blnDataSet As Boolean '★
With Target
' On Error GoTo errEnd
If .Column <= 1 Or .Column >= 4 Or _
.Row = 1 Then End
Select Case .Column
' Case 1
' If .Offset(, 1).Value = "" Then Exit Sub
' hinmei = .Value
' keijyou = .Offset(, 1).Value
' GoTo kakuninEvent
Case 2
If .Offset(, -1).Value = "" Then Exit Sub
hinmei = .Offset(, -1).Value
keijyou = .Value
GoTo kakuninEvent
Case 3
If .Value = "式" Then
Application.EnableEvents = False
.Offset(, 1).Value = 1
.Offset(0, 2).Select
Application.EnableEvents = True
End If
End Select
Exit Sub
kakuninEvent:
Set myRange = Range("A2", Cells(Cells.Rows.Count, 1).End(xlUp).Offset(-1)).Resize(, 5)
a = myRange.Value
Application.EnableEvents = False
Range("C" & .Row).ClearContents
Range("E" & .Row).ClearContents
Application.EnableEvents = True
For i = 1 To myRange.Rows.Count
If hinmei = a(i, 1) And keijyou = a(i, 2) Then
Application.EnableEvents = False
Range("C" & .Row).Value = a(i, 3)
Range("E" & .Row).Value = a(i, 5)
Application.EnableEvents = True
Exit For
End If
Next i
If .Value <> "" And Range("C" & .Row).Value = "" And Range("E" & .Row).Value = "" Then '◆
'単価を検索し設定 '★
Set rngFind = Sheets("商品マスター").Range("A1", Sheets("商品マスター").Range("A65536").End(xlUp))
Set c = rngFind.Find(Target.Offset(, -1).Value, LookIn:=xlValues, LookAt:=xlWhole)
blnDataSet = False
If Not c Is Nothing Then
FirstAddress = c.Address
Do
If .Value = c.Offset(, 1).Value Then
blnDataSet = True
Application.EnableEvents = False
Select Case Range("L1").Value
Case "一般"
.Offset(, 1).Value = c.Offset(, 2).Value '◆
.Offset(, 3).Value = c.Offset(, 3).Value
Case "同業"
.Offset(, 1).Value = c.Offset(, 2).Value '◆
.Offset(, 3).Value = c.Offset(, 4).Value
Case "特別"
.Offset(, 1).Value = c.Offset(, 2).Value '◆
.Offset(, 3).Value = c.Offset(, 5).Value
Case Else
MsgBox "単価種別が違います [" & Range("L1").Value & "]"
End Select
Application.EnableEvents = True
Exit Do
End If
Set c = rngFind.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
If Not blnDataSet Then
MsgBox "単価が見つかりません"
End If
End If '◆
'----ここまで単価検索 '★
'C列に値が入ったかどうかのチェック
With Cells(Target.Row, 3)
If .Value <> "" Then
.Offset(, 1).Activate
Else
.Activate
End If
End With
End With
'errEnd:
End Sub
|
|
かみちゃん
- 06/8/23(水) 17:33 -
