Excel VBA質問箱 IV

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

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


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

【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 お礼[未読]

【59200】表引きをしたい
質問  enachin  - 08/12/2(火) 11:22 -

引用なし
パスワード
   下記のようなマスタ表を重量と径で引いて、定数の値を求めたいのですが、関数だけでも可能でしょうか?

→重量(径共に以下で引きたい)
↓径  マスタ表
  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 G
2 22 130 M
3 38 145 N
4  5 58 F

【59202】Re:表引きをしたい
発言  ひげくま  - 08/12/2(火) 12:08 -

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

この場合、マスタで、重量が20のところは、10超20以下、ということですよね。
これが、20以上30未満、というような仕切り方になっているか、
並びが逆で 50 40 30 というようになっていて、50以下40超なのであれば、
MATCH関数とINDEX関数(or VLOOKUP関数)で何とかなると思います。
(径の並びに関しても同様)

ここはVBA質問箱なので、関数に関してのこれ以上の回答は控えます。

マスタをそのまま使いたいのであれば、他にも関数でやる方法があるのかもしれませんが、私にはマクロを使う方法しか思いつきません。

【59204】Re:表引きをしたい
発言  enachin  - 08/12/2(火) 12:35 -

引用なし
パスワード
   ひげくま さん
こんにちは。
ありがとうございます。
>この場合、マスタで、重量が20のところは、10超20以下、ということですよね。
はい。
>これが、20以上30未満、というような仕切り方になっているか、
>並びが逆で 50 40 30 というようになっていて、50以下40超なのであれば、
>MATCH関数とINDEX関数(or VLOOKUP関数)で何とかなると思います。
>(径の並びに関しても同様)
>
>ここはVBA質問箱なので、関数に関してのこれ以上の回答は控えます。
>
>マスタをそのまま使いたいのであれば、他にも関数でやる方法があるのかもしれませんが、私にはマクロを使う方法しか思いつきません。
マクロでも構いませんので教えて頂けませんか。
よろしくお願いします。

【59205】Re:表引きをしたい
発言  Jaka  - 08/12/2(火) 13:04 -

引用なし
パスワード
   これらとVlookUpの組み合わせで何とかいけそうですね。

=CEILING(18,10)    20
=FLOOR(18,10)    10

詳しくはヘルプを見てください。

【59207】Re:表引きをしたい
発言  enachin  - 08/12/2(火) 13:18 -

引用なし
パスワード
   Jaka さん
こんにちは。
>これらとVlookUpの組み合わせで何とかいけそうですね。
>
>=CEILING(18,10)    20
>=FLOOR(18,10)    10
>
>詳しくはヘルプを見てください。
ありがとうございます。
私のサンプルがまずかったです。
重量と径の増分が固定のようなサンプルでしたが、実は共に
増分が一定ではありません。
よろしくお願いします。

【59210】Re:表引きをしたい
発言  Jaka  - 08/12/2(火) 15:03 -

引用なし
パスワード
   ▼enachin さん:
サンプルがまずかったとか、増分が一定でないとか
どうなっているの解りませんが、
ROUNDDOWN なり ROUNDUP
でも使ったら良いと思います。

【59216】Re:表引きをしたい
発言  enachin  - 08/12/2(火) 16:48 -

引用なし
パスワード
   Jaka さん
ありがとうございます。
>サンプルがまずかったとか、増分が一定でないとか
>どうなっているの解りませんが、
説明が悪くて申し訳ありません。
前回の回答にありました、CEILINGやFLOORで倍数での丸めが可能なことは
HELPで確認しました。で、サンプルは下記のように重量が増分10で径が増分
50になっていますが、この部分が右下のように一定ではないということです。

→重量(径共に以下で引きたい)
↓径  マスタ表
  A  B  C  D  E  F      A  B  C  D  E
1   10 20 30 40 50以下  1   10 100 180 250
2 50 A  B  C  D  E   →2 50 A  B   C   D
3 100 F  G  H  I  J    3 80 F  G  H  I
4 150 K  L  M  N  P    4 150 K  L  M  N

だから、一定の倍数で丸めてもVLOOKUPで一致検索ができないと思った次第です。
>ROUNDDOWN なり ROUNDUP
>でも使ったら良いと思います。
上記理由から同じだと思いますが、間違っておりましたらご指摘ください。
よろしくお願いします。

【59239】Re:表引きをしたい
回答  ひげくま  - 08/12/3(水) 9:18 -

引用なし
パスワード
   マクロを使う場合、

重量18、径70、なら、

・1行目をB1から右へ順にチェックして行き、始めて18以上の数字が出てきたところの列を覚えておく。(この場合はC)
・A列目をA2から下へ順にチェックして行き、始めて70以上の数字が出てきたところの行を覚えておく。(この場合は2)
・記憶しておいた列と行の交わるセル(この場合はC2)の値を取得する。

これだけの作業です。

これを、求めたい重量と径の組み合わせ全てに対して行うだけです。

もしかして、For構文とかIf構文とか、特定のセルの値の取得の仕方とかが解らなかったりしますか?

【59241】Re:表引きをしたい
発言  enachin  - 08/12/3(水) 11:11 -

引用なし
パスワード
   ひげくま さん、ありがとうございます。
>マクロを使う場合、
>重量18、径70、なら、
>・1行目をB1から右へ順にチェックして行き、始めて18以上の数字が出てきたところの列を覚えておく。(この場合はC)
>・A列目をA2から下へ順にチェックして行き、始めて70以上の数字が出てきたところの行を覚えておく。(この場合は2)
>・記憶しておいた列と行の交わるセル(この場合はC2)の値を取得する。
>これだけの作業です。
>これを、求めたい重量と径の組み合わせ全てに対して行うだけです。
>もしかして、For構文とかIf構文とか、特定のセルの値の取得の仕方とかが解らなかったりしますか?
はい、初心者なものですから、言われている事は理解しますが、
もう少し具体的に教えて頂けませんか?
勝ってばかり言いますが...よろしくお願いします。

【59242】Re:表引きをしたい
発言  ひげくま  - 08/12/3(水) 12:05 -

引用なし
パスワード
   初心者ということですが、どこまで解っていて、どこが解らないのでしょうか?

VBAのことをまったく知らなくて最初から最後まで全て作って欲しい、ということではないんですよね?

【59248】Re:表引きをしたい
発言  enachin  - 08/12/3(水) 17:47 -

引用なし
パスワード
   ひげくま さん、ありがとうございます。
>初心者ということですが、どこまで解っていて、どこが解らないのでしょうか?
>VBAのことをまったく知らなくて最初から最後まで全て作って欲しい、ということ
>ではないんですよね?
すいません、まったくといっていいレベルです。
For〜Nextでループさせるとか、Ifで判断するとかは何となく...のレベルです。
よって、前回のB1から右へ順に...とか、列を覚えておく。(この場合はC)とか、
記憶しておいた列と行の交わるセル(この場合はC2)の値を取得するなんては全く
手に負えません。m(__)m
丸投げするつもりはありませんが、今回も含め一つ一つの事例を自分のものに
していきたいと考えますので、サンプルでも結構ですのでよろしくお願いします。

【59249】Re:表引きをしたい
発言  トト  - 08/12/3(水) 19:04 -

引用なし
パスワード
   ▼enachin さん:
質問の主旨と違ってくるかもしれませんが、

「以下」ではなく、「以上」で見出しを作ることは出来ないのでしょうか?
印刷用ではなく、作業用として普段は非表示でも構わないので
「以上」で作れれば、関数で処理できるのですよね?

> →重量(径共に以下で引きたい)
ことから、「以上」と出来ないからこその質問なのかもしれませんが、
訳の分からない(?)VBAと格闘するよりは、今後のメンテの面を考慮しても
そちらの方向性で考えた方が良いような気がします。

ムダスレすみません。

【59254】Re:表引きをしたい
回答  Hirofumi  - 08/12/3(水) 20:24 -

引用なし
パスワード
   こんなので出来そうですが

マスタ表がSheet1に有り
結果がSheet2に有る物とします

Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim lngRows As Long
  Dim lngColumns As Long
  Dim lngRow As Long
  Dim lngColumn As Long
  Dim rngTable As Range
  Dim rngResult As Range
  Dim vntData As Variant
  Dim rngDiameter As Range
  Dim rngWeight As Range
  Dim strProm As String

  '◆マスタ表の先頭セル位置を基準とする(表の左上隅のセル位置)
  Set rngTable = Worksheets("Sheet1").Cells(1, "A")
  
  '◆定数を出力する位置(「重量」の列見出しのセル位置)
  Set rngResult = Worksheets("Sheet2").Cells(1, "A")
  
  With rngTable
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    '列数の取得
    lngColumns = .Offset(, Columns.Count - .Column).End(xlToLeft).Column - .Column
    If lngColumns <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    '径の値の範囲を取得
    Set rngDiameter = .Offset(1).Resize(lngRows)
    '重量の値の範囲を取得
    Set rngWeight = .Offset(, 1).Resize(, lngColumns)
  End With
  
  With rngResult
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    '重量、径の値を配列に取得
    vntData = .Offset(1).Resize(lngRows, 2).Value
  End With
  
  '結果の表のデータ先頭から最終行まで繰り返し
  For i = 1 To lngRows
    '重量を探索
    lngColumn = ListSearch(vntData(i, 1), rngWeight)
    '径を探索
    lngRow = ListSearch(vntData(i, 2), rngDiameter)
    '定数を配列に出力
    vntData(i, 1) = rngTable.Offset(lngRow, lngColumn).Value
  Next i
  
  '画面更新を停止
  Application.ScreenUpdating = False
  
  '結果を出力
  rngResult.Offset(1, 2).Resize(lngRows).Value = vntData
  
  strProm = "処理が完了しました"
   
Wayout:

  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngTable = Nothing
  Set rngResult = Nothing
  Set rngDiameter = Nothing
  Set rngWeight = Nothing

  MsgBox strProm, vbInformation
     
End Sub

Private Function ListSearch(vntKey As Variant, rngScope As Range) As Long

  Dim vntFound As Variant
  
  'Matchによる逐次探索
  vntFound = Application.Match(vntKey, rngScope, 1)
  'もし、エラーで無いなら
  If Not IsError(vntFound) Then
    'もし、Key値と探索位置の値が等しいなら
    If vntKey = rngScope(vntFound).Value Then
      ListSearch = vntFound
    Else
      '戻り値として、行位置を代入
      ListSearch = vntFound + 1
    End If
  Else
    ListSearch = 1
  End If

End Function

PS:
関数でも出来そうですが、式が相当長く成りそうですね

【59255】Re:表引きをしたい
発言  トト  - 08/12/3(水) 20:29 -

引用なし
パスワード
   ごめんなさい

>ムダスレすみません。
ムダレス
間違いです。

失礼しました m(_~_)m

【59257】Re:表引きをしたい
発言  enachin  - 08/12/3(水) 21:00 -

引用なし
パスワード
   Hirofumi さん、ありがとうございます。
>こんなので出来そうですが
>マスタ表がSheet1に有り
>結果がSheet2に有る物とします
>
>Option Explicit
>
>Public Sub Sample()
>
>  Dim i As Long
>  Dim lngRows As Long
>  Dim lngColumns As Long
>  Dim lngRow As Long
>  Dim lngColumn As Long
>  Dim rngTable As Range
>  Dim rngResult As Range
>  Dim vntData As Variant
>  Dim rngDiameter As Range
>  Dim rngWeight As Range
>  Dim strProm As String
>
>  '◆マスタ表の先頭セル位置を基準とする(表の左上隅のセル位置)
>  Set rngTable = Worksheets("Sheet1").Cells(1, "A")
>  
>  '◆定数を出力する位置(「重量」の列見出しのセル位置)
>  Set rngResult = Worksheets("Sheet2").Cells(1, "A")
>  
>  With rngTable
>    '行数の取得
>    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
>    If lngRows <= 0 Then
>      strProm = "データが有りません"
>      GoTo Wayout
>    End If
>    '列数の取得
>    lngColumns = .Offset(, Columns.Count - .Column).End(xlToLeft).Column - .Column
>    If lngColumns <= 0 Then
>      strProm = "データが有りません"
>      GoTo Wayout
>    End If
>    '径の値の範囲を取得
>    Set rngDiameter = .Offset(1).Resize(lngRows)
>    '重量の値の範囲を取得
>    Set rngWeight = .Offset(, 1).Resize(, lngColumns)
>  End With
>  
>  With rngResult
>    '行数の取得
>    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
>    If lngRows <= 0 Then
>      strProm = "データが有りません"
>      GoTo Wayout
>    End If
>    '重量、径の値を配列に取得
>    vntData = .Offset(1).Resize(lngRows, 2).Value
>  End With
>  
>  '結果の表のデータ先頭から最終行まで繰り返し
>  For i = 1 To lngRows
>    '重量を探索
>    lngColumn = ListSearch(vntData(i, 1), rngWeight)
>    '径を探索
>    lngRow = ListSearch(vntData(i, 2), rngDiameter)
>    '定数を配列に出力
>    vntData(i, 1) = rngTable.Offset(lngRow, lngColumn).Value
>  Next i
>  
>  '画面更新を停止
>  Application.ScreenUpdating = False
>  
>  '結果を出力
>  rngResult.Offset(1, 2).Resize(lngRows).Value = vntData
>  
>  strProm = "処理が完了しました"
>   
>Wayout:
>
>  '画面更新を再開
>  Application.ScreenUpdating = True
>  
>  Set rngTable = Nothing
>  Set rngResult = Nothing
>  Set rngDiameter = Nothing
>  Set rngWeight = Nothing
>
>  MsgBox strProm, vbInformation
>     
>End Sub
>
>Private Function ListSearch(vntKey As Variant, rngScope As Range) As Long
>
>  Dim vntFound As Variant
>  
>  'Matchによる逐次探索
>  vntFound = Application.Match(vntKey, rngScope, 1)
>  'もし、エラーで無いなら
>  If Not IsError(vntFound) Then
>    'もし、Key値と探索位置の値が等しいなら
>    If vntKey = rngScope(vntFound).Value Then
>      ListSearch = vntFound
>    Else
>      '戻り値として、行位置を代入
>      ListSearch = vntFound + 1
>    End If
>  Else
>    ListSearch = 1
>  End If
>
>End Function
>
>PS:
>関数でも出来そうですが、式が相当長く成りそうですね
まず、動かしてみます。
私にはかなり高度なコードで理解できるかが不安ですが、コメントを頼りに
流れを追ってみます。
分からない点があれば、また質問させてください。
よろしくお願いします。

【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

と書けば良いです。

【59280】Re:表引きをしたい
お礼  enachin  - 08/12/4(木) 17:08 -

引用なし
パスワード
   ひげくま さん、ありがとうございます。
>既にスマートな回答がありますが、別解として、初心者でも解りやすいと思われる初歩的なものだけを使った、泥臭いやりかたも回答しておきます。
>.......
>.......
>と書けば良いです。
御心遣い本当にありがとうございます。
初心者に優しいコードから上級者向けコードまで
表引きは、色々なケースでよく使いますので、
しっかりと勉強させて頂きます。
ひげくまさん、Hirofumiさん、他皆様色々と
ありがとうございました。

上級者向けコードで理解できない点があれば
また質問させてください。

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