Excel VBA質問箱 IV

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

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


7871 / 13645 ツリー ←次へ | 前へ→

【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 -

引用なし
パスワード
   ▼とろり さん:

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

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

このシートのJ列に

   J
1  150
2  160
3  170
4  180
5  190
6  


コンボボックスの入力範囲として $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 -

引用なし
パスワード
   ▼みなさんこんばんは。
横から失礼します。

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

>
>このシートのJ列に
>
>   J
>1  150
>2  160
>3  170
>4  180
>5  190
>6  
>
>
>コンボボックスの入力範囲として $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 さん:
おはようございます。


>>このシートのJ列に
>>
>>   J
>>1  150
>>2  160
>>3  170
>>4  180
>>5  190
>>6  
>>
>>
>>コンボボックスの入力範囲として $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の方が私には、理解しやすいです。

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

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