Excel VBA質問箱 IV

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

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


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

【33772】ActiveCellの移動による表示切替について わいわい 06/1/20(金) 10:46 質問[未読]
【33781】Re:ActiveCellの移動による表示切替について やっちん 06/1/20(金) 12:30 発言[未読]
【33788】Re:ActiveCellの移動による表示切替につ... わいわい 06/1/20(金) 14:31 質問[未読]
【33789】Re:ActiveCellの移動による表示切替につ... BB 06/1/20(金) 16:31 発言[未読]
【33791】Re:ActiveCellの移動による表示切替につ... わいわい 06/1/20(金) 17:41 質問[未読]
【33801】Re:ActiveCellの移動による表示切替につ... こたつねこ 06/1/20(金) 20:48 発言[未読]
【33804】Re:ActiveCellの移動による表示切替につ... やっちん 06/1/20(金) 21:36 回答[未読]
【33806】Re:ActiveCellの移動による表示切替につ... やっちん 06/1/20(金) 22:42 発言[未読]
【34109】Re:ActiveCellの移動による表示切替につ... わいわい 06/1/26(木) 15:28 お礼[未読]

【33772】ActiveCellの移動による表示切替について
質問  わいわい  - 06/1/20(金) 10:46 -

引用なし
パスワード
   表題の件につき質問致します。
使用している環境は WinXP Excel2000です。

 やりたい事を単純化したものがしたの図になります。
ActiveCellがC列にある場合は、ActiveCellの左隣の値を
Ps_備考()関数に入れ、他の列の場合は空白にする。とい
うものです。

  A  B  C  D
1          ***←ここに=Ps_備考() 
2 
3 10  10 [  ]
4 20  15
5 30  20

そこで、下記の内容を組んだのですが、[Ps_備考()]を
入力したCellを操作しない限り反応しません。

Function Ps_備考()
  Dim 列 As Integer
  
  列 = ActiveCell.Column
  If 列 = 3 Then Ps_備考 = ActiveCell.Offset(, -1).Value _
    Else Ps_備考 = ""
  
End Function

これを、カーソルキー操作だけでなくマウスでの選択でも
D1内表示が切り替わるようにするためにはどうしたら
良いのでしょうか。
御回答のほど宜しくお願い致します。

【33781】Re:ActiveCellの移動による表示切替につ...
発言  やっちん  - 06/1/20(金) 12:30 -

引用なし
パスワード
   ▼わいわい さん:
シートのイベント
Worksheet_SelectionChange
でできますよ。

【33788】Re:ActiveCellの移動による表示切替につ...
質問  わいわい  - 06/1/20(金) 14:31 -

引用なし
パスワード
   やっちん 様

早速のご回答ありがとうございます。
ご助言のありましたWorksheet_SelectionChangeを調べて
以下の内容を作成しました。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  With Target
    If .Column = 3 Then
      [D1].Value = ActiveCell.Offset(, -1).Value
    Else: [D1].Value = ""
    End If
  End With
 
End Sub

これで質問の内容はクリアーになるのですが、実際には
『ActiveCell.Offset(, -1).Value』で得られる値を複数のCellで
利用したいため、質問にあるように『Function Ps_備考()』の関数
にした方が便利(例えばPs_備考(2)で2つ左隣と指定可能とする等)と
考えたのですが、これは可能なのでしょうか?
お礼の場で質問してしまい申し訳ありませんがよろしければ、教え
て頂きたくお願いします。

【33789】Re:ActiveCellの移動による表示切替につ...
発言  BB  - 06/1/20(金) 16:31 -

引用なし
パスワード
   ▼わいわい さん:
>やっちん 様
>
>早速のご回答ありがとうございます。
>ご助言のありましたWorksheet_SelectionChangeを調べて
>以下の内容を作成しました。
>
>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>
>  With Target
>    If .Column = 3 Then
>      [D1].Value = ActiveCell.Offset(, -1).Value
>    Else: [D1].Value = ""
>    End If
>  End With
> 
>End Sub
>
>これで質問の内容はクリアーになるのですが、実際には
>『ActiveCell.Offset(, -1).Value』で得られる値を複数のCellで
>利用したいため、質問にあるように『Function Ps_備考()』の関数
>にした方が便利(例えばPs_備考(2)で2つ左隣と指定可能とする等)と
>考えたのですが、これは可能なのでしょうか?
>お礼の場で質問してしまい申し訳ありませんがよろしければ、教え
>て頂きたくお願いします。

Function Ps_備考(i as integer)
  Dim 列 As Integer
  
  列 = ActiveCell.Column
  If 列 = 3 Then Ps_備考 = ActiveCell.Offset(, -1*i).Value _
    Else Ps_備考 = ""
  
End Function

1つ左の列なら、=Ps_備考(1) って入力
2つ左の列なら、=Ps_備考(2) って入力

【33791】Re:ActiveCellの移動による表示切替につ...
質問  わいわい  - 06/1/20(金) 17:41 -

引用なし
パスワード
   BB 様

回答ありがとうございます。
質問が、言葉足らずになってしまい申し訳ありません。
下記の内容は、理解しております。

>
>Function Ps_備考(i as integer)
>  Dim 列 As Integer
>  
>  列 = ActiveCell.Column
>  If 列 = 3 Then Ps_備考 = ActiveCell.Offset(, -1*i).Value _
>    Else Ps_備考 = ""
>  
>End Function
>
>1つ左の列なら、=Ps_備考(1) って入力
>2つ左の列なら、=Ps_備考(2) って入力

問題は、以下のようにActiveCellの移動(Enter KEY等無し)によって
[D1]を直接弄るのではなく、関数[Ps_備考(i as integer)]により、数値
を変化させるには、どうしたら良いかと言うことです。

>>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>>
>>  With Target
>>    If .Column = 3 Then
>>      [D1].Value = ActiveCell.Offset(, -1).Value
>>    Else: [D1].Value = ""
>>    End If
>>  End With
>> 
>>End Sub

>>      [D1].Value = ActiveCell.Offset(, -1).Value
>>    Else: [D1].Value = ""
単純に考えるとこの2行を変更すればよさそうなのですが
どのように変更すれば良いか分からないのです。
よろしければ、回答お願いします。

【33801】Re:ActiveCellの移動による表示切替につ...
発言  こたつねこ  - 06/1/20(金) 20:48 -

引用なし
パスワード
   ▼わいわい さん:
みなさんこんばんは

>問題は、以下のようにActiveCellの移動(Enter KEY等無し)によって
>[D1]を直接弄るのではなく、関数[Ps_備考(i as integer)]により、数値
>を変化させるには、どうしたら良いかと言うことです。
わいわいさんがどのようにしたいのか今ひとつ理解できないのですが
もしかしてこういうことでしょうか?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim SERU as Range

  For Each SERU In Target
    [D1].Value = Ps_備考(SERU,1)
  Next
 
End Sub


Function Ps_備考(Byval rng as Range,Byval i as integer) as String
  If rng.Column=3 Then
    Ps_備考 = ActiveCell.Offset(, -i).Value
  Else
    Ps_備考 = ""
  End If
End Function

【33804】Re:ActiveCellの移動による表示切替につ...
回答  やっちん  - 06/1/20(金) 21:36 -

引用なし
パスワード
   ▼わいわい さん:
強引にユーザー定義関数を再計算させてみました。
遅い・・・。

Sheet1のモジュールに
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim Rng As Range
  Set Rng = Intersect(Target, Columns("C"))
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  If Rng Is Nothing Then
    Call Y_Set(0)
  Else
    Call Y_Set(Target.Row)
  End If
  Cells.Replace What:="Ps_備考", Replacement:="Ps_備考", LookAt:=xlPart
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

標準モジュールに
Public Y As Long
Function Ps_備考(ByVal I As Long)
  If Y > 0 And I > 0 And I < 3 Then
    Ps_備考 = Cells(Y, 3 - I).Value
  Else
    Ps_備考 = ""
  End If
End Function
Sub Y_Set(ByVal I As Long)
  Y = I
End Sub

【33806】Re:ActiveCellの移動による表示切替につ...
発言  やっちん  - 06/1/20(金) 22:42 -

引用なし
パスワード
   よくよく考えてみると、A列とB列の同じ行の値が必要なだけなので
Selectionchangeで例えばD1とE1に入れて
その2つのセルを参照させればユーザー定義関数は不要なような・・・。
D1とE1で分かりにくければセルに名前を「備考1」、「備考2」と付けて
参照するのもいいですし。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim Rng As Range

  Set Rng = Intersect(Target, Columns("C"))
  Application.EnableEvents = False

  If Rng Is Nothing Then
    Range("D1:E1").Value = ""
  ElseIf Rng.Count > 1 Then
    Range("D1:E1").Value = ""
  Else
    Range("D1:E1").Value = Cells(Target.Row, 1).Resize(, 2).Value
  End If

  Application.EnableEvents = True
End Sub

【34109】Re:ActiveCellの移動による表示切替につ...
お礼  わいわい  - 06/1/26(木) 15:28 -

引用なし
パスワード
   ▼やっちん 様
週末から体調を崩しておりましたため、お礼が遅くなりまして申し訳ありません。
本日、一通り試してみたのですが、やっちんさんの再計算案がイメージに
近い動きでしたが、確かに重いですね。また下の回答の案でも適用できそうなので
そちらの方で試行錯誤して行きます。
というわけで、アドバイスだけ頂いてその成果物をここに掲載できないこと残念です。
今回は、ありがとうございました。

>よくよく考えてみると、A列とB列の同じ行の値が必要なだけなので
>Selectionchangeで例えばD1とE1に入れて
>その2つのセルを参照させればユーザー定義関数は不要なような・・・。
>D1とE1で分かりにくければセルに名前を「備考1」、「備考2」と付けて
>参照するのもいいですし。
>
>Private Sub Worksheet_SelectionChange(ByVal Target As Range)
>  Dim Rng As Range
>
>  Set Rng = Intersect(Target, Columns("C"))
>  Application.EnableEvents = False
>
>  If Rng Is Nothing Then
>    Range("D1:E1").Value = ""
>  ElseIf Rng.Count > 1 Then
>    Range("D1:E1").Value = ""
>  Else
>    Range("D1:E1").Value = Cells(Target.Row, 1).Resize(, 2).Value
>  End If
>
>  Application.EnableEvents = True
>End Sub

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