Excel VBA質問箱 IV

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

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


8522 / 13646 ツリー ←次へ | 前へ→

【32661】金額を入力すると、購買可能な果物の一覧表を作成したい 価格表 05/12/20(火) 15:51 質問[未読]
【32664】Re:金額を入力すると、購買可能な果物の一... Hip 05/12/20(火) 16:03 発言[未読]
【32676】Re:金額を入力すると、購買可能な果物の一... 価格表 05/12/20(火) 17:53 回答[未読]
【32689】Re:金額を入力すると、購買可能な果物の一... Po 05/12/20(火) 20:24 発言[未読]
【32752】Re:金額を入力すると、購買可能な果物の一... 価格表 05/12/21(水) 16:44 発言[未読]
【32690】Re:金額を入力すると、購買可能な果物の一... やっちん 05/12/20(火) 20:35 発言[未読]
【32756】Re:金額を入力すると、購買可能な果物の一... 価格表 05/12/21(水) 16:47 質問[未読]
【32764】Re:金額を入力すると、購買可能な果物の一... こたつねこ 05/12/21(水) 19:25 回答[未読]
【32811】Re:金額を入力すると、購買可能な果物の一... 価格表 05/12/22(木) 15:17 お礼[未読]

【32661】金額を入力すると、購買可能な果物の一覧...
質問  価格表  - 05/12/20(火) 15:51 -

引用なし
パスワード
   【セルに金額を入力すると、購買可能な果物の一覧表が表示されるようにしたい】

エクセルで以下のような表を作りました。

   A     B
1 果物    金額
 −−−−−−−−−−
2 メロン   3,000
3 さくらんぼ 2,000
4 マンゴー  500
5 りんご   300
6 桃     700
7 みかん   200

そしてA9に金額を入力する欄を作成しました。
A10 から A14 には以下の関数が入っており、
入力した金額が、リストにある果物の金額以下なら果物名を、
そうでないなら×を表示させるようにしています。
=IF(A9>=A2,B2,"×")
=IF(A9>=A3,B3,"×")
=IF(A9>=A4,B4,"×")
=IF(A9>=A5,B5,"×")
=IF(A9>=A6,B6,"×")
=IF(A9>=A7,B7,"×")

例えばC3に400と入力すると、以下のように返ってきます。
×
×
×
りんご
×
みかん

最終的に×以外の文字を表示させたいのですが、
どうすればいいのでしょうか?
教えて下さい。

【32664】Re:金額を入力すると、購買可能な果物の...
発言  Hip  - 05/12/20(火) 16:03 -

引用なし
パスワード
   こんにちは

どこに表示したいのでしょうか?

【32676】Re:金額を入力すると、購買可能な果物の...
回答  価格表  - 05/12/20(火) 17:53 -

引用なし
パスワード
   ▼Hip さん:
>こんにちは
>
>どこに表示したいのでしょうか?

同じシートの、果物の名前と金額が入った表の隣です

【32689】Re:金額を入力すると、購買可能な果物の...
発言  Po  - 05/12/20(火) 20:24 -

引用なし
パスワード
   ▼価格表 さん:

意味が今ひとつ分からないのですが

D2に式を入れれば後は、オートフィルで…
C列に金額を入れると
OKは○、そうでないものは果物名がでます。


>↓
>   A     B     c    d
>1 果物    金額         ↓ ↓
> −−−−−−−−−−
>2 メロン   3,000        =IF(C2<=B2,"○",A2)
>3 さくらんぼ 2,000
>4 マンゴー  500
>5 りんご   300
>6 桃     700
>7 みかん   200
>

【32690】Re:金額を入力すると、購買可能な果物の...
発言  やっちん  - 05/12/20(火) 20:35 -

引用なし
パスワード
   ▼価格表 さん:
一覧表ではなくてもわかればいいということであれば
条件付書式で購買可能な果物のセルに色を付けることもできます。

【32752】Re:金額を入力すると、購買可能な果物の...
発言  価格表  - 05/12/21(水) 16:44 -

引用なし
パスワード
   オートフィルターを使わずにはできませんでしょうか?
できれば金額を入れた後、何の処理もなく結果を表示したいのですが・・・

▼Po さん:
>▼価格表 さん:
>
>意味が今ひとつ分からないのですが
>
>D2に式を入れれば後は、オートフィルで…
>C列に金額を入れると
>OKは○、そうでないものは果物名がでます。
>
>
>>↓
>>   A     B     c    d
>>1 果物    金額         ↓ ↓
>> −−−−−−−−−−
>>2 メロン   3,000        =IF(C2<=B2,"○",A2)
>>3 さくらんぼ 2,000
>>4 マンゴー  500
>>5 りんご   300
>>6 桃     700
>>7 みかん   200
>>

【32756】Re:金額を入力すると、購買可能な果物の...
質問  価格表  - 05/12/21(水) 16:47 -

引用なし
パスワード
   色をつけることもできるんですね。
ただ やはり一覧表を作りたいので。。。
でもでも、ありがとうございます。
貴重な案をいただき、とても嬉しかったです。


▼やっちん さん:
>▼価格表 さん:
>一覧表ではなくてもわかればいいということであれば
>条件付書式で購買可能な果物のセルに色を付けることもできます。

【32764】Re:金額を入力すると、購買可能な果物の...
回答  こたつねこ  - 05/12/21(水) 19:25 -

引用なし
パスワード
   価格表さん、みなさんこんばんは

最初の関数を使用したいのなら、VBAで×以外を転記する
という方法でやればどうでしょう?

関数を使用せず全てVBAでと言うことであれば、以下の
コードをシートモジュールに貼り付けてC1セルに希望の
金額を入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range)
 Const lngStart As Long = 2 'データ開始行
 Dim SERU As Range
 Dim lngEnd As Long
 Dim lngRow As Long
 Dim i As Long
 
 For Each SERU In Target
   If SERU.Address(0, 0) = "C1" Then
     '転記開始行セット
     lngRow = 2
     With ActiveSheet
       .Range("C" & lngRow, .Range("C" & lngRow).End(xlDown)).Clear
       lngEnd = .Range("A65536").End(xlUp).Row
       For i = lngStart To lngEnd
         If .Cells(i, 2).Value <= SERU.Value Then
           .Cells(lngRow, "C").Value = .Cells(i, 1).Value
           lngRow = lngRow + 1
         End If
       Next i
     End With
   End If
 Next
End Sub

【32811】Re:金額を入力すると、購買可能な果物の...
お礼  価格表  - 05/12/22(木) 15:17 -

引用なし
パスワード
   お忙しいところ丁寧にありがとうございます。
さっそくやってみます!!!


▼こたつねこ さん:
>価格表さん、みなさんこんばんは
>
>最初の関数を使用したいのなら、VBAで×以外を転記する
>という方法でやればどうでしょう?
>
>関数を使用せず全てVBAでと言うことであれば、以下の
>コードをシートモジュールに貼り付けてC1セルに希望の
>金額を入力してみてください。
>
>Private Sub Worksheet_Change(ByVal Target As Range)
> Const lngStart As Long = 2 'データ開始行
> Dim SERU As Range
> Dim lngEnd As Long
> Dim lngRow As Long
> Dim i As Long
> 
> For Each SERU In Target
>   If SERU.Address(0, 0) = "C1" Then
>     '転記開始行セット
>     lngRow = 2
>     With ActiveSheet
>       .Range("C" & lngRow, .Range("C" & lngRow).End(xlDown)).Clear
>       lngEnd = .Range("A65536").End(xlUp).Row
>       For i = lngStart To lngEnd
>         If .Cells(i, 2).Value <= SERU.Value Then
>           .Cells(lngRow, "C").Value = .Cells(i, 1).Value
>           lngRow = lngRow + 1
>         End If
>       Next i
>     End With
>   End If
> Next
>End Sub

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