Excel VBA質問箱 IV

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

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


962 / 13644 ツリー ←次へ | 前へ→

【77235】ルーブ 翔子 15/6/25(木) 11:10 質問[未読]
【77236】Re:ルーブ kanabun 15/6/25(木) 12:05 発言[未読]
【77237】Re:ルーブ 翔子 15/6/25(木) 12:37 質問[未読]
【77239】Re:ルーブ kanabun 15/6/25(木) 12:46 発言[未読]
【77240】Re:ルーブ kanabun 15/6/25(木) 13:01 発言[未読]
【77238】Re:ルーブ kanabun 15/6/25(木) 12:43 発言[未読]
【77241】Re:ルーブ 翔子 15/6/25(木) 14:38 質問[未読]
【77242】Re:ルーブ kanabun 15/6/25(木) 15:06 発言[未読]
【77243】Re:ルーブ 翔子 15/6/25(木) 15:22 質問[未読]
【77244】Re:ルーブ 翔子 15/6/25(木) 15:35 質問[未読]

【77235】ルーブ
質問  翔子  - 15/6/25(木) 11:10 -

引用なし
パスワード
   よろしくお願いします。

下記のモジュールは
Sheet(注文書)E2にコードを入れると
Sheet(詳細)E列”コード”、F列”品名”
1行目はタイトル、2行目から”1から最終行”、”品名”が
入っています。

Sheet(注文書)E2にコードを入れボタンを押すと
Sheet(注文書)E3にコードの品名が出てくるようになっております。

*Sheet(注文書)E2にコードを入れenterキーでしたいのですが
 可能でしょうか教えてください

Sub 部署コード検索() 'ボタン検索
  Dim i As String '注文書シート(E2)
  Dim s As String '詳細シート
  Dim r As String '詳細シート 部署コード2行目
  Dim m As Integer 'MsgBox
  
  i = Worksheets("注文書").Range("E2")
  r = 2: m = 1
  Do While Worksheets("詳細").Cells(r, 5) <> ""
    s = Worksheets("詳細").Cells(r, 5)
    If StrComp(i, s) = 0 Then
      Worksheets("注文書").Range("E3").Value = Worksheets("詳細").Cells(r, 6)
      m = 3
      Exit Do
    End If
    r = r + 1
  Loop
    
  If m = 1 Then
    MsgBox "入力されたコードはありません"
  End If
End Sub

【77236】Re:ルーブ
発言  kanabun  - 15/6/25(木) 12:05 -

引用なし
パスワード
   ▼翔子 さん:

>Sheet(注文書)E2にコードを入れボタンを押すと
>Sheet(注文書)E3にコードの品名が出てくるようになっております。
>
>*Sheet(注文書)E2にコードを入れenterキーでしたいのですが
> 可能でしょうか教えてください

可能です。
いま標準モジュールにそのコードを書いていますが、
それを 注文書シートの シートモジュールに変更し、
たとえば、以下のようにコードを書けばいいです。

Private Sub Worksheet_Change(ByVal Target As Range)

  If Target.Address(0, 0) <> "E2" Then Exit Sub
  
  Dim Rg As Range
  Dim m As Variant
  With Worksheets("詳細") '別シートのコード照合セル範囲
    Set Rg = .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
  End With
  m = Application.Match(Target, Rg, 0) 'Match関数で「詳細」シート検索
  Application.EnableEvents = False
  If IsNumeric(m) Then
    Target.Offset(1).Value = Rg.Item(m, 2).Value
  Else
    Target.Offset(1).ClearContents
    MsgBox "入力されたコードはありません"
  End If
  Application.EnableEvents = True
  
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
は シートに入力があったとき 実行されます。

いまは [E2]セル以外は入力があっても、さっさと抜けるようにしてあります。

今はMatch関数で コードを検索していますが、
やりたいことは VLookUpなので それを使っても可能です。

【77237】Re:ルーブ
質問  翔子  - 15/6/25(木) 12:37 -

引用なし
パスワード
   kanabun様
ありがとうございます。

「名前が適切ではないとでました」

【77221】Re:関数ではなくてマクロでやりたいのです。
の、Private Sub Worksheet_Change(ByVal Target As Range)
と同じ所にあるからですか?

【77238】Re:ルーブ
発言  kanabun  - 15/6/25(木) 12:43 -

引用なし
パスワード
   [E2]セルにコードを入力するのでなく、すでに入っていたコードを消去してから
あたらしいコードを入力する人もいるかもしれないので、
[E2]セルがクリアされたときのことも考慮して、
こうしておいた方が親切かも?

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address(0, 0) <> "E2" Then Exit Sub
  
  Dim Rg As Range
  Dim m As Variant
  With Worksheets("詳細") '別シートのコード照合セル範囲
    Set Rg = .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
  End With
  Application.EnableEvents = False
  If IsEmpty(Target) Then
    Target.Offset(1).ClearContents
  Else
    m = Application.Match(Target, Rg, 0) 'Match関数で「詳細」シート検索
    If IsNumeric(m) Then
      Target.Offset(1).Value = Rg.Item(m, 2).Value
    Else
      Target.Offset(1).ClearContents
      MsgBox "入力されたコードはありません"
    End If
  End If
  Application.EnableEvents = True
  
End Sub

【77239】Re:ルーブ
発言  kanabun  - 15/6/25(木) 12:46 -

引用なし
パスワード
   ▼翔子 さん:

>
>「名前が適切ではないとでました」
>
> 【77221】Re:関数ではなくてマクロでやりたいのです。
>の、Private Sub Worksheet_Change(ByVal Target As Range)
>と同じ所にあるからですか?

そうです。同じ名前のプロシージャは複数作れません。
すでに書いてあるコードを ここに再度 アップしてください。

【77240】Re:ルーブ
発言  kanabun  - 15/6/25(木) 13:01 -

引用なし
パスワード
   ちょっと出かけますので、とりあえずあてずっぽで m(_ _)m

'入力のあったセルが [E2]のときは (1) を実行し、
'[D6:D10]のときは (2)を実行するように If〜 Else〜 End If構文で分岐処理して
'ください

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
Dim c As Range
'(1) -----------------------------------------------------------
If Target.Address(0, 0) = "E2" Then
  Dim m As Variant
  With Worksheets("詳細") '別シートのコード照合セル範囲
    Set Rg = .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
  End With
  Application.EnableEvents = False
  If IsEmpty(Target) Then
    Target.Offset(1).ClearContents
  Else
    m = Application.Match(Target, Rg, 0) 'Match関数で検索
    If IsNumeric(m) Then
      Target.Offset(1).Value = Rg.Item(m, 2).Value
    Else
      Target.Offset(1).ClearContents
      MsgBox "入力されたコードはありません"
    End If
  End If
  Application.EnableEvents = True
  
'(2) -----------------------------------------------------------
Else
  Set Rg = Intersect(Target, Range("D6:D10"))
  If Rg Is Nothing Then Exit Sub
 
  Application.EnableEvents = False
  For Each c In Rg
    If Not IsEmpty(c.Value) Then
      c.Offset(, -1).Value = Range("E3").Value
    End If
  Next
  Application.EnableEvents = True
  
End If
End Sub

【77241】Re:ルーブ
質問  翔子  - 15/6/25(木) 14:38 -

引用なし
パスワード
   kanabun様

77240のモジュールは動きませんでした。

1、Sheet注文書(E2)コードを入力enterで
2、Sheet詳細(F列コード),(E列品名)から
  Sheet注文書(E3)に品名を持ってくる
Sheet注文書での処理
3、D6に値が入ったら、C6にE3の品名が入るように。
4、D7に値が入ったら、C7にE3の品名が入るように。
5、D8に値が入ったら、C8にE3の品名が入るように。
6、D9に値が入ったら、C9にE3の品名が入るように。
7、D10に値が入ったら、C10にE3の品名が入るように。
よろしくお願いします。

【77242】Re:ルーブ
発言  kanabun  - 15/6/25(木) 15:06 -

引用なし
パスワード
   ▼翔子 さん:

>
>77240のモジュールは動きませんでした。
>
>1、Sheet注文書(E2)コードを入力enterで
>2、Sheet詳細(F列コード),(E列品名)から
>  Sheet注文書(E3)に品名を持ってくる
>Sheet注文書での処理
>3、D6に値が入ったら、C6にE3の品名が入るように。
>4、D7に値が入ったら、C7にE3の品名が入るように。
>5、D8に値が入ったら、C8にE3の品名が入るように。
>6、D9に値が入ったら、C9にE3の品名が入るように。
>7、D10に値が入ったら、C10にE3の品名が入るように。

> 動きませんでした
というのは、注文書[E2]にコードを入力しても、[E3]に検索された品名が
表示されなかったのですか?
それとも [D6:D10]のどれかのセルを変更したら、横のE列のセルに[E3]の
値が転記されなかったのですか?

それとも、両方 できなかったのですか?


それと、
>2、Sheet詳細(F列コード),(E列品名)から
とここでは書いておられるけど、

一番最初の説明では
> Sheet(詳細)E列”コード”、F列”品名”
じゃなかったですか?

【77243】Re:ルーブ
質問  翔子  - 15/6/25(木) 15:22 -

引用なし
パスワード
   kanabunsama


両方うごきませんでした。

Sheet(詳細)E列”コード”、F列”品名”です。

【77244】Re:ルーブ
質問  翔子  - 15/6/25(木) 15:35 -

引用なし
パスワード
   ▼kanabun様

誠に申し訳ありません。

Sheet注文書(E3:G3)
セルぬ結合をなくしたらうごきました

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