Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

7870 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

▼

【36352】プラスマイナスの値の抽出 とろり 06/3/29(水) 19:12

【36353】Re:プラスマイナスの値の抽出 Hirofumi 06/3/29(水) 20:12

【36354】Re:プラスマイナスの値の抽出 ichinose 06/3/29(水) 20:14

【36355】Re:プラスマイナスの値の抽出 とろり 06/3/29(水) 20:31

【36356】Re:プラスマイナスの値の抽出 Hirofumi 06/3/29(水) 20:44

【36357】Re:プラスマイナスの値の抽出 ichinose 06/3/29(水) 20:49

【36358】Re:プラスマイナスの値の抽出 とろり 06/3/29(水) 21:02

【36361】Re:プラスマイナスの値の抽出 ichinose 06/3/29(水) 22:07

【36367】Re:プラスマイナスの値の抽出 ponpon 06/3/29(水) 23:02

【36372】Re:プラスマイナスの値の抽出 ichinose 06/3/30(木) 7:06

【36373】Re:プラスマイナスの値の抽出 ponpon 06/3/30(木) 7:32

【36359】Re:プラスマイナスの値の抽出 Kein 06/3/29(水) 21:15


	【36352】プラスマイナスの値の抽出

とろり - 06/3/29(水) 19:12 -


	引用なし

	パスワード

みなさん、こんにちは。とろりです。
私の為に少しお時間下さい。

さっそく質問です。

　　A　　B
1 氏名　身長
2　あ　 100
3　い　 110
4　う　 120
5　え　 130
6　お　 140
7　か　 150
8　き　 160
9　く　 170
10 け　 180
11 こ　 190
12 さ　 200

というような感じでずらーっとデータが並んでいます。
例えば、「150」を基準として、そのプラスマイナス30の値と
なる人を全て抽出することは可能でしょうか？
(抽出される人→う・え・お・か・き・く・け)

もし可能ならば、どのようにすればよいでしょか？
すみませんが、みなさんのお力を分けて下さい。
よろしくお願いします。


	【36353】Re:プラスマイナスの値の抽出

Hirofumi - 06/3/29(水) 20:12 -


	引用なし

	パスワード

こんなかな？

Option Explicit

Public Sub Sample()

　　'基準値を設定
　　Const clngBase As Long = 150
　　
　　Dim i As Long
　　Dim lngRows As Long
　　Dim rngList As Range
　　Dim vntData As Variant
　　Dim rngResult As Range
　　Dim lngRow As Long
　　Dim strProm As String
　　
　　'Listの左上隅セル位置を基準として設定(列見出し「氏名」のセル位置)
　　Set rngList = ActiveSheet.Cells(1, "A")
　　'出力する位置を設定(列見出し「氏名」のセル位置)
　　Set rngResult = ActiveSheet.Cells(1, "D")
　　'列見出しをCopy
　　rngList.Copy Destination:=rngResult
　　'出力行初期値
　　lngRow = 1
　　
　　With rngList
　　　　'データ行数を取得
　　　　lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
　　　　'データが無い場合
　　　　If lngRows <= 0 Then
　　　　　　strProm = "データが有りません"
　　　　　　GoTo Wayout
　　　　End If
　　　　'データを配列に取得
　　　　vntData = .Offset(1).Resize(lngRows, 2).Value
　　End With
　　
　　'画面更新を停止
　　Application.ScreenUpdating = False
　　
　　'先頭行から最終行まで繰り返し
　　For i = 1 To lngRows
　　　　'(150-30)以上、(150+30)以下なら
　　　　If clngBase - 30 <= vntData(i, 2) _
　　　　　　　　And vntData(i, 2) <= clngBase + 30 Then
　　　　　　'氏名を転記
　　　　　　rngResult.Offset(lngRow).Value = vntData(i, 1)
　　　　　　'転記行を更新
　　　　　　lngRow = lngRow + 1
　　　　End If
　　Next i
　　　　
　　strProm = "処理が完了しました"
　　
Wayout:
　　
　　'画面更新を再開
　　Application.ScreenUpdating = True
　　
　　Set rngList = Nothing
　　Set rngResult = Nothing
　　
　　MsgBox strProm, vbInformation
　　
End Sub


	【36354】Re:プラスマイナスの値の抽出

ichinose - 06/3/29(水) 20:14 -


	引用なし

	パスワード

▼とろりさん：
こんばんは。

>
>さっそく質問です。
>
>　　A　　B
>1 氏名　身長
>2　あ　 100
>3　い　 110
>4　う　 120
>5　え　 130
>6　お　 140
>7　か　 150
>8　き　 160
>9　く　 170
>10 け　 180
>11 こ　 190
>12 さ　 200
>
>というような感じでずらーっとデータが並んでいます。
>例えば、「150」を基準として、そのプラスマイナス30の値と
>なる人を全て抽出することは可能でしょうか？
>(抽出される人→う・え・お・か・き・く・け)
標準モジュールに
'==============================================
Sub main()
　　Dim rng As Range
　　Dim stdval As Long
　　Dim permval As Long
　　Dim ans As Variant
　　stdval = 150　'←基準値
　　permval = 30　'←許容値
　　Set rng = Range("a2", Cells(Rows.Count, 1).End(xlUp))
　　If rng.Row > 1 Then
　　　 With rng
　　　　　func = "=if(abs(" & .Offset(0, 1).Address & "-" & _
　　　　　　　　 stdval & ")<=" & permval & _
　　　　　　　　 "," & .Address & ",""" & Chr(&HFF) & """)"
　　　　　'func--- =if(abs($B$2:$B$12-150)<=30,$A$2:$A$12,"�")
　　　　　'例えば、↑こんな数式が評価されます
　　　　　ans = Evaluate(func)
　　　　　If TypeName(ans) = "Variant()" Then
　　　　　　 ans = Application.Transpose(ans)
　　　　　Else
　　　　　　 ans = Array(ans)
　　　　　　 End If
　　　　　ans = Filter(ans, Chr(&HFF), False)
　　　　　If UBound(ans) >= 0 Then
　　　　　　 MsgBox Join(ans, ",")
　　　　　　 End If
　　　　　End With
　　　 End If
End Sub

例のようなデータがあるシートをアクティブにした状態で
mainを実行してみて下さい。
結果は、メッセージボックスで表示されます。


	【36355】Re:プラスマイナスの値の抽出

とろり - 06/3/29(水) 20:31 -


	引用なし

	パスワード

Hirofumiさん、ichinoseさん。
どうもありがとうございます。大変助かります(><)!!

すみませんが・・・
基準値がコンボボックスから選択するような形になっていて、
コロコロ変わったりする場合はどのような感じになりますか？
可能でしょうか？

よろしくお願いします。


	【36356】Re:プラスマイナスの値の抽出

Hirofumi - 06/3/29(水) 20:44 -


	引用なし

	パスワード

UserFormのListBoxの場合

UsetFormのコードモジュールに以下を記述

Option Explicit

Private Sub ListBox1_Click()

　　
　　Extraction ListBox1.Value
　　
End Sub

Private Sub UserForm_Initialize()

　　Dim i As Long
　　
　　With ListBox1
　　　　For i = 100 To 200 Step 10
　　　　　　.AddItem i
　　　　Next i
　　End With
　　
End Sub

'標準モジュールに記述

Option Explicit

Public Sub Extraction(lngBase As Long)

　　Dim i As Long
　　Dim lngRows As Long
　　Dim rngList As Range
　　Dim vntData As Variant
　　Dim rngResult As Range
　　Dim lngRow As Long
　　Dim strProm As String
　　
　　'Listの左上隅セル位置を基準として設定(列見出し「氏名」のセル位置)
　　Set rngList = ActiveSheet.Cells(1, "A")
　　'出力する位置を設定(列見出し「氏名」のセル位置)
　　Set rngResult = ActiveSheet.Cells(1, "D")
　　'列見出しをCopy
　　rngList.Copy Destination:=rngResult
　　'出力行初期値
　　lngRow = 1
　　
　　With rngResult
　　　　'データ行数を取得
　　　　lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
　　　　'データが無い場合
　　　　If lngRows > 0 Then
　　　　　　.Offset(1).Resize(lngRows).ClearContents
　　　　End If
　　End With
　　
　　With rngList
　　　　'データ行数を取得
　　　　lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
　　　　'データが無い場合
　　　　If lngRows <= 0 Then
　　　　　　strProm = "データが有りません"
　　　　　　GoTo Wayout
　　　　End If
　　　　'データを配列に取得
　　　　vntData = .Offset(1).Resize(lngRows, 2).Value
　　End With
　　
　　'画面更新を停止
　　Application.ScreenUpdating = False
　　
　　'先頭行から最終行まで繰り返し
　　For i = 1 To lngRows
　　　　'(150-30)以上、(150+30)以下なら
　　　　If lngBase - 30 <= vntData(i, 2) _
　　　　　　　　And vntData(i, 2) <= lngBase + 30 Then
　　　　　　'氏名を転記
　　　　　　rngResult.Offset(lngRow).Value = vntData(i, 1)
　　　　　　'転記行を更新
　　　　　　lngRow = lngRow + 1
　　　　End If
　　Next i
　　　　
　　strProm = "処理が完了しました"
　　
Wayout:
　　
　　'画面更新を再開
　　Application.ScreenUpdating = True
　　
　　Set rngList = Nothing
　　Set rngResult = Nothing
　　
　　MsgBox strProm, vbInformation
　　
End Sub


	【36357】Re:プラスマイナスの値の抽出

ichinose - 06/3/29(水) 20:49 -


	引用なし

	パスワード

▼とろりさん：
>基準値がコンボボックスから選択するような形になっていて、
>コロコロ変わったりする場合はどのような感じになりますか？
>可能でしょうか？
そのコンボボックスで選択した基準値を取得する記述は大丈夫ですか？
どこに貼り付けたコンボボックスかによって記述は違ってきます。
コンボボックスで選択した基準値が取得できれば、
私のコードでは、

stdval = 150

の代わりに

stdval=コンボボックスで選択した値 '←ここの記述は調べて見てください

とするだけです。


	【36358】Re:プラスマイナスの値の抽出

とろり - 06/3/29(水) 21:02 -


	引用なし

	パスワード

Hirofumiさん、ichinoseさん。
またまたありがとうございます。ホントに感謝してます。

説明不足な点が少しあった為、再度書きます。
コンボボックスの使い方としては、ワークシート上にコンボボックスを
置いてます。そのコンボボックスの「ｺﾝﾄﾛｰﾙの書式設定」にて
入力範囲を選択しており、リンクするセルを入力範囲で選択した値の下に
設定しています。

上記の様な使い方での記述はどうなるんでしょうか？
質問ばかりで、本当にすみません・・・。
またお願い出来ませんか(;_;)？


	【36359】Re:プラスマイナスの値の抽出

Kein - 06/3/29(水) 21:15 -


	引用なし

	パスワード

B1セルをダブルクリックしたとき、そこへフォームツールバーの
コンボボックスを配置し、身長を選択できるようにするなら

[シートモジュール]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
　 Dim Lp As Single, Wp As Single, Hp As Single
　 Dim i As Integer

　 With Target
　　　If .Address <> "$B$1" Then Exit Sub
　　　Lp = .Left: Wp = .Width: Hp = .Height
　 End With
　 Cancel = True: Rows.Hidden = False
　 With ActiveSheet.DropDowns.Add(Lp, 0, Wp, Hp)
　　　For i = 100 To 250 Step 10
　　　　 .AddItem CStr(i)
　　　Next i
　　　.OnAction = "MyBorder"
　 End With
End Sub

[標準モジュール]

Sub MyBorder()
　 Dim Num1 As Integer, Num2 As Integer

　 If VarType(Application.Caller) <> 8 Then Exit Sub
　 With ActiveSheet.DropDowns(1)
　　　Num1 = CInt(.List(.ListIndex)) - 30
　　　Num2 = CInt(.List(.ListIndex)) + 30
　　　.Delete
　 End With
　 On Error Resume Next
　 With Range("B2", Range("B65536").End(xlUp)).Offset(, 1)
　　　.Formula = "=IF(AND($B2>=" & Num1 & ",$B2<=" & Num2 & "),"""",1)"
　　　.SpecialCells(3, 1).EntireRow.Hidden = True
　　　.ClearContents
　 End With
End Sub　　


	【36361】Re:プラスマイナスの値の抽出

ichinose - 06/3/29(水) 22:07 -


	引用なし

	パスワード

▼とろりさん：

>説明不足な点が少しあった為、再度書きます。
>コンボボックスの使い方としては、ワークシート上にコンボボックスを
>置いてます。そのコンボボックスの「ｺﾝﾄﾛｰﾙの書式設定」にて
>入力範囲を選択しており、リンクするセルを入力範囲で選択した値の下に
>設定しています。
これも最初のご質問の時のように具体例を提示してください。
そうしないとこちらで提示しなければなりません。

Ａ列、Ｂ列にデータが入力されているシートに
コマンドバー「フォーム」のコンボボックスが貼り付けられているとします。

このシートのＪ列に

　　　Ｊ
１　　150
２　　160
３　　170
４　　180
５　　190
６　　

コンボボックスの入力範囲として　$J$1:$J$5
　リンクするセルとして　$J$6

と設定されているとします。

この場合は、

　 stdval = 150

の箇所を

　 stdval = Range("offset(j1,j6-1,0,1,1)").Value

に変更してコンボボックスで基準値を設定後、mainを実行します。

確認してみて下さい。


	【36367】Re:プラスマイナスの値の抽出

ponpon - 06/3/29(水) 23:02 -


	引用なし

	パスワード

▼みなさんこんばんは。
横から失礼します。

私も作ってみたのですが・・・

>
>このシートのＪ列に
>
>　　　Ｊ
>１　　150
>２　　160
>３　　170
>４　　180
>５　　190
>６　　
>
>
>コンボボックスの入力範囲として　$J$1:$J$5
>　リンクするセルとして　$J$6
>
>と設定されているとします。
>
>この場合は、
>
>　 stdval = 150
>
>の箇所を
>
>　 stdval = Range("offset(j1,j6-1,0,1,1)").Value
>

ここのところが分かりませんでした。

　 stdval = Range("offset(j1,j6-1,0,1,1)").Value

この"offset(j1,j6-1,0,1,1)"は、どんな意味なのでしょうか？
何をヘルプで調べるとよいでしょうか？

Sub test()
　　Dim myR As Range
　　Dim myNO As Integer
　　Dim r As Range
　　Dim i As Long
　　Dim j As Long
　　Dim myVal() As String
　　
　　With Sheets("Sheet1")
　　　　 myNO = Range("offset(j1,j6-1,0,1,1)").Value

　　　　 Set myR = .Range("B2", .Range("B65536").End(xlUp))
　　　　 For Each r In myR
　　　　　　If r.Value <= myNO + 30 And r.Value >= myNO - 30 Then
　　　　　　　 ReDim Preserve myVal(i)
　　　　　　　 myVal(i) = r.Offset(, -1).Value
　　　　　　　 i = i + 1
　　　　　　End If
　　　　 Next
　　　　 If UBound(myVal) > 0 Then
　　　　　　.Range("D:D").ClearContents　'D列に書き出す
　　　　　　For j = LBound(myVal) To UBound(myVal)
　　　　　　　.Range("D1").Value = "抽出者"
　　　　　　　.Cells(j + 2, 4) = myVal(j)
　　　　　　Next
　　　　 End If
　　End With
End Sub


	【36372】Re:プラスマイナスの値の抽出

ichinose - 06/3/30(木) 7:06 -


	引用なし

	パスワード

▼ponpon さん：
おはようございます。

>>このシートのＪ列に
>>
>>　　　Ｊ
>>１　　150
>>２　　160
>>３　　170
>>４　　180
>>５　　190
>>６　　
>>
>>
>>コンボボックスの入力範囲として　$J$1:$J$5
>>　リンクするセルとして　$J$6
>>
>>と設定されているとします。
>>
>>この場合は、
>>
>>　 stdval = 150
>>
>>の箇所を
>>
>>　 stdval = Range("offset(j1,j6-1,0,1,1)").Value
>>
>
>ここのところが分かりませんでした。
>
>　 stdval = Range("offset(j1,j6-1,0,1,1)").Value
>
>この"offset(j1,j6-1,0,1,1)"は、どんな意味なのでしょうか？
>何をヘルプで調べるとよいでしょうか？

これは、ワークシート関数のOffsetですよ。
Offset関数は、セル範囲の参照を返す関数ですから、

例えば、

Sub test()
　　MsgBox Range("j1:j5").Address & "===" & Range("offset(j1,0,0,5,1)").Address
　　MsgBox Range("j4").Address & "===" & Range("offset(j1,3,0,1,1)").Address

End Sub

を実行するとわかりますが、
Range("J4")　は、　Range("offset(j1,3,0,1,1)")と記述出来ます。

コマンドバー「フォーム」のコンボボックスで

>>コンボボックスの入力範囲として　$J$1:$J$5
>>　リンクするセルとして　$J$6

と設定すると

offset(j1,j6-1,0,1,1)

がコンボボックスが選択した値に該当するセルを
参照していることを理解してください。

"j4"がセル参照の記述で

Range("j4")と記述出来るのですから，

同じセル参照の"offset(j1,3,0,1,1)"が

Range("offset(j1,3,0,1,1)")と記述出来ることも理解してください！！

よって、

　　stdval = Range("offset(j1,j6-1,0,1,1)").Value

が有効と言うことになります。

因みに上記は

　　stdval = Range("index(j1:j5,j6,1)").Value

なんて記述もできます（Indexもワークシート関数です）。

確認してみて下さい


	【36373】Re:プラスマイナスの値の抽出

ponpon - 06/3/30(木) 7:32 -


	引用なし

	パスワード

▼ichinose さん：

>
>これは、ワークシート関数のOffsetですよ。
>Offset関数は、セル範囲の参照を返す関数ですから、

いつもながら、お馬鹿な質問をしてしまいました。
Offset関数なんて使ったことなかったものですから・・・・
VBAでは、いつも使うのですが、引数が違うのですね。
offsetとresizeを合わせたようなものなんだ。
普通にワークシート関数を調べれば何のことはなかったのですね。
すみませんでした。

ワークシート関数も少しずつはやっているのですが、
よくすばらしい関数の組み合わせに、3行も4行もあるような
関数を見てしまうと脳が拒否してしまいます。
まだ、VBAの方が私には、理解しやすいです。

ありがとうございました。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

7870 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free