Excel VBA質問箱 IV

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

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


22840 / 76732 ←次へ | 前へ→

【59267】Re:表引きをしたい
回答  ひげくま  - 08/12/4(木) 8:52 -

引用なし
パスワード
   既にスマートな回答がありますが、別解として、初心者でも解りやすいと思われる初歩的なものだけを使った、泥臭いやりかたも回答しておきます。

シート名:マスタ
→重量
↓径
------------------------
| A  B  C  D  E  F
-|-----------------------
1|  10 20 30 40 50以下
2| 50 A  B  C  D  E
3|100 F  G  H  I  J
4|150 K  L  M  N  P

マクロを実行するときのアクティブシート
 重量 径 定数
------------
| A  B  C
-|----------
1|18 70
2|22 130
3|38 145
4| 5 58

として、

・アクティブシートの重量と径の値は両方が書き込まれていること
・アクティブシートの重量と径は上から順に並んでいて空行が無いこと
・アクティブシートの重量も径も、マスタシートの表の数値以上になっていないこと
という前提のもとで、マクロは、ツール−マクロ−マクロ でtestを実行する場合、

Sub test()

  Dim RowX '求めるデータの行番号
  RowX = 1 '調べたいデータが1行目から始まっているから

  'アクティブシートのA列を、データがなくなるまで順にチェック
  Do Until Cells(RowX, 1).Value = ""
  
    '重量と直径の値を渡せば定数が戻ってくる関数test2に、
    '各行の1列目と2列目の値を渡し、戻り値を3列目に代入
    Cells(RowX, 3).Value = test2(Cells(RowX, 1).Value, Cells(RowX, 2).Value)
    
    '次に調べる行を1つ下に進めるために、RowXを1増やす
    RowX = RowX + 1
  
  Loop

End Sub

'重量Wと直径Dの値を受け取って、定数を返す関数
Function test2(W, D)

  'アクティブシートではなく、マスタシートでの作業なので、
  'Withでマスタシートを指定
  'その際に、マスタシートのセルを示す場合は、.Cellsというように、「.」を頭につけること
  With Worksheets("マスタ")
  
    Dim ColMem '重量列記憶用
    Dim RowMem '直径行記憶用

    ColMem = 2 '重量を調べ始める列が2列目だから
    RowMem = 2 '直径を調べ始める行が2行目だから

    'A2(=.Cell(1, 2))から右に順に調べて、最初にD以上になるセルの列を取得
    Do Until .Cells(1, ColMem).Value = ""
      
      '重量が引数W以上の場合は、Doループを抜ける
      If .Cells(1, ColMem).Value >= W Then
        Exit Do
      End If
      
      '次に調べる列を1つ右に進めるために、Colmemを1増やす
      ColMem = ColMem + 1
    
    Loop
    
    '直径に関しても同様
    '詳細コメントは省略
    Do Until .Cells(RowMem, 1).Value = ""
      
      If .Cells(RowMem, 1).Value >= D Then
        Exit Do
      End If
      
      RowMem = RowMem + 1
    
    Loop
    
    '求めた列と行から、定数を取得し、戻り値test2に代入
    test2 = .Cells(RowMem, ColMem).Value
    
  End With

End Function

と書けば良いです。
2 hits

【59200】表引きをしたい enachin 08/12/2(火) 11:22 質問
【59202】Re:表引きをしたい ひげくま 08/12/2(火) 12:08 発言
【59204】Re:表引きをしたい enachin 08/12/2(火) 12:35 発言
【59205】Re:表引きをしたい Jaka 08/12/2(火) 13:04 発言
【59207】Re:表引きをしたい enachin 08/12/2(火) 13:18 発言
【59210】Re:表引きをしたい Jaka 08/12/2(火) 15:03 発言
【59216】Re:表引きをしたい enachin 08/12/2(火) 16:48 発言
【59239】Re:表引きをしたい ひげくま 08/12/3(水) 9:18 回答
【59241】Re:表引きをしたい enachin 08/12/3(水) 11:11 発言
【59242】Re:表引きをしたい ひげくま 08/12/3(水) 12:05 発言
【59248】Re:表引きをしたい enachin 08/12/3(水) 17:47 発言
【59249】Re:表引きをしたい トト 08/12/3(水) 19:04 発言
【59255】Re:表引きをしたい トト 08/12/3(水) 20:29 発言
【59254】Re:表引きをしたい Hirofumi 08/12/3(水) 20:24 回答
【59257】Re:表引きをしたい enachin 08/12/3(水) 21:00 発言
【59267】Re:表引きをしたい ひげくま 08/12/4(木) 8:52 回答
【59280】Re:表引きをしたい enachin 08/12/4(木) 17:08 お礼

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