Excel VBA質問箱 IV

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

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


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

【24267】表引きの定石をご教示下さい daihan 05/4/18(月) 9:23 質問[未読]
【24272】Re:表引きの定石をご教示下さい ウッシ 05/4/18(月) 12:06 回答[未読]
【24278】Re:表引きの定石をご教示下さい daihan 05/4/18(月) 13:38 発言[未読]
【24280】Re:表引きの定石をご教示下さい Jaka 05/4/18(月) 13:58 発言[未読]
【24281】Re:表引きの定石をご教示下さい ウッシ 05/4/18(月) 14:26 回答[未読]
【24285】Re:表引きの定石をご教示下さい G-Luck 05/4/18(月) 17:20 発言[未読]
【24287】Re:表引きの定石をご教示下さい daihan 05/4/18(月) 17:50 発言[未読]
【24290】Re:表引きの定石をご教示下さい G-Luck 05/4/18(月) 18:25 発言[未読]
【24293】Re:表引きの定石をご教示下さい daihan 05/4/18(月) 19:22 お礼[未読]
【24296】Re:表引きの定石をご教示下さい ウッシ 05/4/18(月) 19:48 回答[未読]
【24298】Re:表引きの定石をご教示下さい daihan 05/4/18(月) 22:20 発言[未読]
【24352】Re:表引きの定石をご教示下さい daihan 05/4/20(水) 9:36 発言[未読]
【24360】Re:表引きの定石をご教示下さい ウッシ 05/4/20(水) 15:27 回答[未読]
【24518】Re:表引きの定石をご教示下さい Daihan 05/4/23(土) 23:17 発言[未読]
【24520】Re:表引きの定石をご教示下さい ウッシ 05/4/24(日) 0:41 回答[未読]
【24286】Re:表引きの定石をご教示下さい daihan 05/4/18(月) 17:32 発言[未読]
【24327】Re:表引きの定石をご教示下さい Jaka 05/4/19(火) 16:03 回答[未読]
【24354】Re:表引きの定石をご教示下さい daihan 05/4/20(水) 10:08 質問[未読]
【24297】Re:表引きの定石をご教示下さい Hirofumi 05/4/18(月) 21:48 回答[未読]
【24299】Re:表引きの定石をご教示下さい daihan 05/4/18(月) 22:26 発言[未読]
【24351】Re:表引きの定石をご教示下さい daihan 05/4/20(水) 8:58 お礼[未読]
【24372】Re:表引きの定石をご教示下さい Hirofumi 05/4/20(水) 20:22 回答[未読]
【24516】Re:表引きの定石をご教示下さい Daihan 05/4/23(土) 23:10 お礼[未読]

【24267】表引きの定石をご教示下さい
質問  daihan  - 05/4/18(月) 9:23 -

引用なし
パスワード
   いつもお世話になっております。
どなたか表引きの定石をご教示下さい。
品名コードと重量をキーにして、マスタシートから充填個数を表引きしたいのです。

(例
28365 りんご (りんごの品名コードを28365とします)
下記の[シート1]の充填数を表引きで得たい。
この場合、シート2で28365の品名コードにて行を特定し、次に重量85gから16個という充填個数を得ます。

[シート1]
品名コード 品名 重量 充填数
28365   りんご 85  ??←16を表引きで得たい。

[シート2](マスタシート)
品名コード 重量(g) それぞれの数値以下で見る →
     50  70  90  110  130  150  170  190  210
---------------------------------------------------------------------
28365   20  18  16  14   12   10   10   8   8
28366   20  18  16  14   12   10   10   8   8
28367   22  20  18  16   14   12   12   12   10

よろしくお願いします。

【24272】Re:表引きの定石をご教示下さい
回答  ウッシ  - 05/4/18(月) 12:06 -

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

列位置、行位置、シート名がはっきりしないのですが、

[Sheet1]
   A    B   C   D
1  品名コード 品名 重量 充填数
2  28365   りんご 85  ??←16を表引きで得たい。

[Sheet2](マスタシート)
  A        B   C   D   E   F   G   H   I   J
1 品名コード/重量(g) 50  70  90  110  130  150  170  190  210
2 28365       20  18  16  14   12   10   10   8   8
3 28366       20  18  16  14   12   10   10   8   8
4 28367       22  20  18  16   14   12   12   12   10

として[Sheet1]のD2に
=IF(MAX(Sheet2!$1:$1)>=C2,IF(ISERROR(INDEX(Sheet2!A:J,MATCH(A2,Sheet2!
A:A,0),MATCH(C2,Sheet2!$1:$1,1))),"",INDEX(Sheet2!A:J,MATCH(A2,Sheet2!
A:A,0),MATCH(C2,Sheet2!$1:$1,1))),"")

のような数式をセットするのはどうでしょうか?

【24278】Re:表引きの定石をご教示下さい
発言  daihan  - 05/4/18(月) 13:38 -

引用なし
パスワード
   ▼ウッシ さん:
こんにちは、早速のレスありがとうございます。
>として[Sheet1]のD2に
>=IF(MAX(Sheet2!$1:$1)>=C2,IF(ISERROR(INDEX(Sheet2!A:J,MATCH(A2,Sheet2!
>A:A,0),MATCH(C2,Sheet2!$1:$1,1))),"",INDEX(Sheet2!A:J,MATCH(A2,Sheet2!
>A:A,0),MATCH(C2,Sheet2!$1:$1,1))),"")
>
>のような数式をセットするのはどうでしょうか?
関数でも可能なんですね!
早速試してみます。
それと、マクロでやる場合の定石もご教示願えませんか。
よろしくお願いします。

【24280】Re:表引きの定石をご教示下さい
発言  Jaka  - 05/4/18(月) 13:58 -

引用なし
パスワード
   こんにちは。
また関数です。

振り分けが今一わかりませんが...・
=OFFSET(Sheet2!A1,MATCH(A2,Sheet2!A:A,0)-1,MATCH(C2+19,Sheet2!1:1,1)-1,1,1)

【24281】Re:表引きの定石をご教示下さい
回答  ウッシ  - 05/4/18(月) 14:26 -

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

>85  ??←16を表引きで得たい。
>それぞれの数値以下で見る →
という部分が良く分からないのですが、重量に例えば「250」とか入った場合どうすれば
いいのでしょうか?
先ほどの数式は「それぞれの数値以上」を見てます。

「Sheet1」のシートタブを右クリックして「コードの表示」でシートモジュールを
出して下記コードを貼り付けて下さい。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  Dim hRng As Range
  Dim col As Variant
  With Target
    If .Count > 1 Then Exit Sub
    If Intersect(.Cells, Range("A2,C2")) Is Nothing Then Exit Sub
    If IsEmpty(Range("A2").Value) Or _
      IsEmpty(Range("C2").Value) Then
      Exit Sub
    End If
    With Worksheets("Sheet2")
      Set hRng = .Range("A2", .Range("A65536").End(xlUp)).Find( _
        Range("A2").Value, , xlFormulas, xlWhole)
      If hRng Is Nothing Then
        MsgBox "品名コード該当無し。", 64
        Exit Sub
      End If
      
      col = Application.Match(Range("C2").Value, .Rows(1), 1)
      
      Application.EnableEvents = False
      If .Cells(1, col).Value <> Range("C2").Value Then
        Range("D2").Value = hRng.Offset(, col).Value
      Else
        Range("D2").Value = hRng.Offset(, col - 1).Value
      End If
      Application.EnableEvents = True
    
    End With
  End With
End Sub

【24285】Re:表引きの定石をご教示下さい
発言  G-Luck  - 05/4/18(月) 17:20 -

引用なし
パスワード
   趣味の世界に突入ですが、式で案外シンプルに出来たので記します。
重量の最大値を超えた場合はエラーになりますが、
配列数式を利用して、

{=VLOOKUP(A2,Sheet2!A:J,MATCH(TRUE,(C2<=Sheet2!B1:J1),0)+1,FALSE)}

MATCH(TRUE,(C2<=Sheet2!B1:J1),0)
がみそですね。
{True,False,・・・}を作って、最初のTrueの位置を取得しています。

【24286】Re:表引きの定石をご教示下さい
発言  daihan  - 05/4/18(月) 17:32 -

引用なし
パスワード
   ▼Jaka さん:
Jakaさん、ウッシさん、こんにちは。
レスありがとうございます。
>振り分けが今一わかりませんが...・
>=OFFSET(Sheet2!A1,MATCH(A2,Sheet2!A:A,0)-1,MATCH(C2+19,Sheet2!1:1,1)-1,1,1)
説明が今ひとつで申し訳ありません。
[Sheet2]の1行目の横並び数字は重量のしきい値で、それぞれ以下で見ます。
例えば重量が40gだと、最初のB列の50以下ですから20を取り、60gだと、次の70g以下ですから18を取るといった具合です。
それと、ウッシさんの問いにありました250gの場合は?
これは、勝手にあり得ないと言う事でMaxは210g以下にしています。
それと、何せ初心者な物ですからチョット解説を入れて頂くとありがたいのですが...
勝手ばかり言って申し訳ありませんが、よろしくお願いします。m(_ _)m

【24287】Re:表引きの定石をご教示下さい
発言  daihan  - 05/4/18(月) 17:50 -

引用なし
パスワード
   ▼G-Luck さん:
G-Luckさん、こんにちは。
>趣味の世界に突入ですが、式で案外シンプルに出来たので記します。
これでもか!みたいなすごい数式ですね!(?_?)
>重量の最大値を超えた場合はエラーになりますが、配列数式を利用して、
と言う事は、全体を「IF(ISERROR(...」に入れれば回避できると言う事ですよね?
>{=VLOOKUP(A2,Sheet2!A:J,MATCH(TRUE,(C2<=Sheet2!B1:J1),0)+1,FALSE)}
>
>MATCH(TRUE,(C2<=Sheet2!B1:J1),0)
>がみそですね。
>{True,False,・・・}を作って、最初のTrueの位置を取得しています。
すいませんが、もう少し解説を下さい、よろしくお願いします。m(_ _)m

【24290】Re:表引きの定石をご教示下さい
発言  G-Luck  - 05/4/18(月) 18:25 -

引用なし
パスワード
   ▼daihan さん:
こんにちは、

>と言う事は、全体を「IF(ISERROR(...」に入れれば回避できると言う事ですよね?
そうですね。ウッシさんみたいに最大値を超えた場合にErrと表示みたいでもいいですね。

>すいませんが、もう少し解説を下さい、よろしくお願いします。m(_ _)m
ツールバーの「ワークシート分析」の一番右にある「数式の検証」を使うと一段階づつ進めれるのでわかりやすいですよ。

検証の時は範囲を大きくとると、表示に時間がかかるので、下記のように
{=VLOOKUP(A2,Sheet2!A2:J4,MATCH(TRUE,(C2<=Sheet2!B1:J1),0)+1,FALSE}
した方がいいです。
あと、
{=MATCH(TRUE,(C2<=Sheet2!B1:J1),0)}
だけで、調べてみるとわかるとおもいます。 
ちなみに、{}で囲まれた式を配列数式といって、入力方法は、
=MATCH(TRUE,(C2<=Sheet2!B1:J1),0)
と入力して、Ctrl+Shift+Enterでできます。

【24293】Re:表引きの定石をご教示下さい
お礼  daihan  - 05/4/18(月) 19:22 -

引用なし
パスワード
   ▼G-Luck さん:
G-Luck さん、こんばんは。
>ツールバーの「ワークシート分析」の一番右にある「数式の検証」を使うと一段階
>づつ進めれるのでわかりやすいですよ。
当方Excel2000の為、一番右には「入力規則マークのクリア」があり、「数式の検証」はメニューにも見あたりません。
>検証の時は範囲を大きくとると、表示に時間がかかるので、下記のように
>{=VLOOKUP(A2,Sheet2!A2:J4,MATCH(TRUE,(C2<=Sheet2!B1:J1),0)+1,FALSE}
>した方がいいです。
>あと、
>{=MATCH(TRUE,(C2<=Sheet2!B1:J1),0)}
>だけで、調べてみるとわかるとおもいます。 
>ちなみに、{}で囲まれた式を配列数式といって、入力方法は、
>=MATCH(TRUE,(C2<=Sheet2!B1:J1),0)
>と入力して、Ctrl+Shift+Enterでできます。
配列数式ですか、もう少し自分なりに学習してみます。
ありがとうございました。

【24296】Re:表引きの定石をご教示下さい
回答  ウッシ  - 05/4/18(月) 19:48 -

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

一部修正も有ります。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  '品名コード、重量検索時用の変数
  Dim hRng As Range
  Dim col As Variant
  With Target
    '変更セルが複数の場合終了
    If .Count > 1 Then Exit Sub
    '変更セルがA2、C2以外の場合終了
    If Intersect(.Cells, Range("A2,C2")) Is Nothing Then Exit Sub
    'A2、C2のどちらかが空の場合終了
    If IsEmpty(Range("A2").Value) Or _
      IsEmpty(Range("C2").Value) Then
      Exit Sub
    End If
    With Worksheets("Sheet2")
      '品名コードでSheet2のA列のデータ範囲を検索
      Set hRng = .Range("A2", .Range("A65536").End(xlUp)).Find( _
        Range("A2").Value, , xlFormulas, xlWhole)
      '品名コードが無かったら終了
      If hRng Is Nothing Then
        MsgBox "品名コード該当無し。", 64
        Exit Sub
      End If
      
      'Sheet2の1行目の重量が昇順に並んでいるとして
      'C2で指定した重量以下の最大値の入っている列番を取得
      col = Application.Match(Range("C2").Value, .Rows(1), 1)
      
      'イベントの発生を抑制
      Application.EnableEvents = False
      'C2で指定した重量が最小値以下のエラー対応
      If IsError(col) Then col = 1
      'C2で指定した重量がSheet2の1行目の重量に一致した場合の対応
      If .Cells(1, col).Value <> Range("C2").Value Then
        Range("D2").Value = hRng.Offset(, col).Value
      Else
        Range("D2").Value = hRng.Offset(, col - 1).Value
      End If
      'イベント発生の抑制解除
      Application.EnableEvents = True
    
    End With
  End With
End Sub

【24297】Re:表引きの定石をご教示下さい
回答  Hirofumi  - 05/4/18(月) 21:48 -

引用なし
パスワード
   VBAでやるならこんなでも善いかな?
Sheet1、Sheet2は、ウッシさんの提示したレイアウトと同じとします

Option Explicit

Public Sub Sample()

'  マクロとして使う場合

  Dim i As Long
  Dim lngPos As Long
  Dim rngWeight As Range
  Dim rngCode As Range
  Dim lngRows As Long
    
  '表の先頭セル位置(「品名コード/重量(g)」の書いて有るセル)
  With Worksheets("Sheet2").Cells(1, "A")
    '重量(g)の書いて有る列数を取得
    lngPos = .End(xlToRight).Column - .Column
    '重量(g)の書いて有る範囲を設定
    Set rngWeight = .Offset(, 1).Resize(, lngPos)
    '品名コードの有る行数を取得
    lngPos = .End(xlDown).Row - .Row
    '品名コードの有る範囲を設定
    Set rngCode = .Offset(1).Resize(lngPos)
  End With
  
  '結果表の先頭セル位置(「品名コード」の書いて有るセル)
  With Worksheets("Sheet1").Cells(1, "A")
    'データ行数を取得
    lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
    'データ先頭から最終まで繰り返し
    For i = 1 To lngRows
      .Offset(i, 3).Value = DataReference(.Offset(i).Value, _
                  .Offset(i, 2).Value, rngCode, rngWeight)
    Next i
  End With
  
  Beep
  MsgBox "処理が完了しました"
  
End Sub

'ユーザー定義関数として使う場合は、
'vntCodeに品名コードのセルを指定
'vntWeightに重量のセルを指定
'rngCodeにSheet2の商品コードの書いて有るセル範囲を指定
'rngWeightにSheet2の重量の書いて有る範囲を指定
Public Function DataReference(vntCode As Variant, _
                vntWeight As Variant, _
                rngCode As Range, _
                rngWeight As Range) As Variant
  
  Dim lngFoundCode As Long
  Dim lngFoundWeight As Long
  Dim lngOver As Long
  
  
  '商品コードの位置を探索
  lngFoundCode = DataSearch(vntCode, rngCode)
  '該当商品コードが無い場合
  If lngFoundCode = 0 Then
    DataReference = "該当商品コード無し"
    Exit Function
  End If
  
  '重量(g)の位置を探索
  lngFoundWeight = DataSearch(vntWeight, rngWeight, lngOver)
  '該当重量が無い場合
  If lngFoundWeight = 0 Then
    If lngOver = 0 Then
      DataReference = "該当重量無し"
      Exit Function
    Else
      'Key値を超える最小値のある位置に
      lngFoundWeight = lngOver
    End If
  End If
  
  '発見した、行列位置の値を戻り値として返す
  With rngCode
    DataReference = .Item(lngFoundCode).Offset(, lngFoundWeight).Value
  End With
  
End Function

Private Function DataSearch(vntKey As Variant, _
            rngScope As Range, _
            Optional lngOver As Long) As Long

  Dim vntFind As Variant
  
  If vntKey = "" Then
    Exit Function
  End If
  
  'Matchによる二分探索
  vntFind = Application.Match(vntKey, rngScope, 1)
  'もし、エラーで無いなら
  If Not IsError(vntFind) Then
    'もし、Key値と探索位置の値が等しいなら
    If vntKey = rngScope(vntFind).Value Then
      '戻り値として、行位置を代入
      DataSearch = vntFind
    End If
    'Key値を超える最小値のある行
    If vntFind = rngScope.Count Then
      lngOver = 0
    Else
      lngOver = vntFind + 1
    End If
  Else
    lngOver = 1
  End If
  
End Function

【24298】Re:表引きの定石をご教示下さい
発言  daihan  - 05/4/18(月) 22:20 -

引用なし
パスワード
   ▼ウッシ さん:
ウッシ さん、こんばんは。
レスありがとうございます。
早速試してみます。

【24299】Re:表引きの定石をご教示下さい
発言  daihan  - 05/4/18(月) 22:26 -

引用なし
パスワード
   ▼Hirofumi さん:
Hirofumi さん、こんばんは。
レスありがとうございます。
>VBAでやるならこんなでも善いかな?
>Sheet1、Sheet2は、ウッシさんの提示したレイアウトと同じとします
早速試してみます。

【24327】Re:表引きの定石をご教示下さい
回答  Jaka  - 05/4/19(火) 16:03 -

引用なし
パスワード
   Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  Dim scr As Integer
  If Target.Count > 1 Then Exit Sub
  If Target.Address(0, 0) <> "C2" Then Exit Sub
  If Target.Value = "" Then Exit Sub
  If Application.IsNumber(Target.Value) = False Then Exit Sub
  If Target.Value < 40 Then
    scr = 40
  Else
    scr = Target.Value
  End If
  Application.EnableEvents = False
  kns = "OFFSET(Sheet21!A1,MATCH(A2,Sheet21!A:A,0)-1," & _
     "MATCH(" & scr & "+19,Sheet21!1:1,1)-1,1,1)"
  ans = Application.Evaluate(kns)
  Range("D2").Value = ans
  Application.EnableEvents = True
End Sub

上はこれ↓のエクセル関数をマクロで実行しただけ。(ちょっと違うけど)

=IF(C2<40,OFFSET(Sheet21!A1,MATCH(A2,Sheet21!A:A,0)-1,
MATCH(40+19,Sheet21!1:1,1)-1,1,1),OFFSET(Sheet21!A1,
MATCH(A2,Sheet21!A:A,0)-1,MATCH(C2+19,Sheet21!1:1,1)-1,1,1))

要は、MATCHで目的の値を検索して、A1セル基準にOFFSETで、右に〇個、下に×個づらした所を参照しているだけです。
+19は、よく解ってないけど最小の近似値を拾ってくれているみたいなので....。

50+19=69 で、50
51+19=70 で、70
69+19=88 で、70
70+19=79 で、70
71+19=80 で、80

【24351】Re:表引きの定石をご教示下さい
お礼  daihan  - 05/4/20(水) 8:58 -

引用なし
パスワード
   ▼daihan さん:
Hirofumi さん、おはようございます。
遅くなりましたが、やっと理解できて実体に即した修正後実行しましたら、
バッチリです、ありがとうございました。
まだまだ初心者で、お尋ねする事が多いと思いますが、
今後ともよろしくお願い致します。

【24352】Re:表引きの定石をご教示下さい
発言  daihan  - 05/4/20(水) 9:36 -

引用なし
パスワード
   ▼daihan さん:
ウッシ さん、おはようございます。
>Private Sub Worksheet_Change(ByVal Target As Excel.Range)
>  '品名コード、重量検索時用の変数
>  Dim hRng As Range
>  Dim col As Variant
>  With Target
>    '変更セルが複数の場合終了
>    If .Count > 1 Then Exit Sub
>    '変更セルがA2、C2以外の場合終了
>    If Intersect(.Cells, Range("A2,C2")) Is Nothing Then Exit Sub
試そう(実体に即した修正をしよう)と理解を始めたんですが、
上記、Worksheet_Change(...と言う事と、6行目の'変更セルがA2、C2以外の場合終了というコメントから、[Sheet1]のA2、C2に値を入れたらD2が表示される仕組みだと理解しました。
これまた私の説明不足が原因で申し訳ありませんが、[Sheet1]のA2〜C2迄が数万行入ったシートがあって、そのD列を[Sheet2]を表引きしながらマクロで埋めたかったのです。
理解しながら、その形に改造を試みていた途中でHirofumiさんのレスが入って、内容的に私の思いと一致しているみたいだったので、そちらを先に試してしまいました。
すいません。m(_ _)m

そこで、素人の私が改造するより、思いが伝われば玄人のウッシさんに直してもらった方が早いと思いますので勝手ばかり言ってすいませんが、お願いできますでしょうか? よろしくお願いします。m(_ _)m

【24354】Re:表引きの定石をご教示下さい
質問  daihan  - 05/4/20(水) 10:08 -

引用なし
パスワード
   ▼Jaka さん:
Jakaさん、おはようございます。
初心者に優しいレスありがとうございます。
>Private Sub Worksheet_Change(ByVal Target As Excel.Range)
>  Dim scr As Integer
>  If Target.Count > 1 Then Exit Sub
>  If Target.Address(0, 0) <> "C2" Then Exit Sub
>  If Target.Value = "" Then Exit Sub
>  If Application.IsNumber(Target.Value) = False Then Exit Sub
これまた私の説明不足が原因で申し訳ありませんが、[Sheet1]のA2〜C2迄が数万行入ったシートがあって、そのD列を[Sheet2]を表引きしながらマクロで埋めたかったのです。

>  If Target.Value < 40 Then
>    scr = 40
>  Else
>    scr = Target.Value
>  End If
それと、上記の<40で判断されているのは?
どういう意図なのでしょうか?

>  Application.EnableEvents = False
>  kns = "OFFSET(Sheet21!A1,MATCH(A2,Sheet21!A:A,0)-1," & _
>     "MATCH(" & scr & "+19,Sheet21!1:1,1)-1,1,1)"
>  ans = Application.Evaluate(kns)
>  Range("D2").Value = ans
>  Application.EnableEvents = True
すいませんが、上記のApplication.EnableEvents = の意味(何の為に)と、この間の処理内容を教えて頂けませんか?

1つでも多くの手法を身に着けたいと思いますので、
何卒よろしくお願いします。m(_ _)m

【24360】Re:表引きの定石をご教示下さい
回答  ウッシ  - 05/4/20(水) 15:27 -

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

数万行分も一括で処理するなら、こちらの方で試して下さい。

Sub test1()
  Application.ScreenUpdating = False
  With Worksheets("Sheet1")
    With .Range("A2", .Range("A65536").End(xlUp)).Offset(, 3)
      .FormulaR1C1 = _
        "=IF(RC3>Sheet2!R1C10,""""," & _
        "VLOOKUP(RC1,Sheet2!C1:C10," & _
        "IF(RC3<=Sheet2!R1C2,2," & _
        "IF(RC3=OFFSET(Sheet2!R1C1,,MATCH(RC3,Sheet2!R1,1)-1)," & _
        "MATCH(RC3,Sheet2!R1,1),MATCH(RC3,Sheet2!R1,1)+1)),0))"

      .Copy
      .PasteSpecial xlValues
    End With
  End With
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

【24372】Re:表引きの定石をご教示下さい
回答  Hirofumi  - 05/4/20(水) 20:22 -

引用なし
パスワード
   データが、数万行も有ると
最初のコードでは、えらく遅いと思います
因って、少し速くなる様にして見ました
ただし、今回のFunction DataReference2は、
ユーザー定義関数として使えませんので宜しく

Option Explicit

Public Sub Sample2()

'  マクロとして使う場合

  Dim i As Long
  Dim lngPos As Long
  Dim rngWeight As Range
  Dim rngCode As Range
  Dim lngRows As Long
  Dim vntList As Variant
  Dim vntData As Variant
  Dim vntResult As Variant
  
  '表の先頭セル位置(「品名コード/重量(g)」の書いて有るセル)
  With Worksheets("Sheet2").Cells(1, "A")
    '重量(g)の書いて有る列数を取得
    lngPos = .End(xlToRight).Column - .Column
    '重量(g)の書いて有る範囲を設定
    Set rngWeight = .Offset(, 1).Resize(, lngPos)
    '品名コードの有る行数を取得
    lngPos = .End(xlDown).Row - .Row
    '品名コードの有る範囲を設定
    Set rngCode = .Offset(1).Resize(lngPos)
    '表のデータ範囲を配列に取得
    vntList = .Offset(1, 1).Resize(lngPos, rngWeight.Columns.Count).Value
  End With
  
  '結果表の先頭セル位置(「品名コード」の書いて有るセル)
  With Worksheets("Sheet1").Cells(1, "A")
    'データ行数を取得
    lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
    '結果出力用配列を確保
    ReDim vntResult(1 To lngRows, 1 To 1)
    'データ先頭から最終まで繰り返し
    For i = 1 To lngRows
      'データ1行分を配列に取得
      vntData = .Offset(i).Resize(, 3).Value
      '探索結果を出力用配列に代入
      vntResult(i, 1) = DataReference2(vntData(1, 1), vntData(1, 3), _
                          rngCode, rngWeight, vntList)
    Next i
    '結果用配列を出力
    .Offset(1, 3).Resize(lngRows).Value = vntResult
  End With
  
  Beep
  MsgBox "処理が完了しました"
  
End Sub

Private Function DataReference2(vntCode As Variant, _
                vntWeight As Variant, _
                rngCode As Range, _
                rngWeight As Range, _
                vntList As Variant) As Variant
  
  Dim lngFoundCode As Long
  Dim lngFoundWeight As Long
  Dim lngOver As Long
  
  
  '商品コードの位置を探索
  lngFoundCode = DataSearch(vntCode, rngCode)
  '該当商品コードが無い場合
  If lngFoundCode = 0 Then
    DataReference2 = "該当商品コード無し"
    Exit Function
  End If
  
  '重量(g)の位置を探索
  lngFoundWeight = DataSearch(vntWeight, rngWeight, lngOver)
  '該当重量が無い場合
  If lngFoundWeight = 0 Then
    If lngOver = 0 Then
      DataReference2 = "該当重量無し"
      Exit Function
    Else
      'Key値を超える最小値のある位置に
      lngFoundWeight = lngOver
    End If
  End If
  
  '発見した、行列位置の値を戻り値として返す
  With rngCode
    DataReference2 = vntList(lngFoundCode, lngFoundWeight)
  End With
  
End Function

Private Function DataSearch(vntKey As Variant, _
            rngScope As Range, _
            Optional lngOver As Long) As Long

  Dim vntFind As Variant
  
  If vntKey = "" Then
    Exit Function
  End If
  
  'Matchによる二分探索
  vntFind = Application.Match(vntKey, rngScope, 1)
  'もし、エラーで無いなら
  If Not IsError(vntFind) Then
    'もし、Key値と探索位置の値が等しいなら
    If vntKey = rngScope(vntFind).Value Then
      '戻り値として、行位置を代入
      DataSearch = vntFind
    End If
    'Key値を超える最小値のある行
    If vntFind = rngScope.Count Then
      lngOver = 0
    Else
      lngOver = vntFind + 1
    End If
  Else
    lngOver = 1
  End If
  
End Function

【24516】Re:表引きの定石をご教示下さい
お礼  Daihan  - 05/4/23(土) 23:10 -

引用なし
パスワード
   ▼Hirofumi さん:
Hirofumi さん、こんばんは。
大変遅くなって申し訳ありません。m(_ _)m
前回のSample()で取り敢えず目先の仕事を片付けるのに追われておりました。
>データが、数万行も有ると
>最初のコードでは、えらく遅いと思います
>因って、少し速くなる様にして見ました
わざわざ改良版のご教示までして頂き、本当にありがとうございました。
で、やっと目先の仕事に目処が付いたので再度改良版を改造して改良(改)版と従来番の速度比較をしてみてびっくりしました!!
何と!、従来版で約22秒掛かっていたものが、改良(改)版だと約2秒で終わっちゃいました!
こんな事なら...急がば回れで再度改良版を改造してから仕事を片づけていれば...
でも、なった事に感動していたのと、目先の仕事量に焦っていたので、つい...
初心者ですねーーー (^_^;
本当にありがとうございました。
今後ともよろしくお願いします。

【24518】Re:表引きの定石をご教示下さい
発言  Daihan  - 05/4/23(土) 23:17 -

引用なし
パスワード
   ▼ウッシ さん:
ウッシ さん、こんばんは。
大変遅くなって申し訳ありません。m(_ _)m
前回のSample()で取り敢えず目先の仕事を片付けるのに追われておりました。
>数万行分も一括で処理するなら、こちらの方で試して下さい。
>Sub test1()
>  Application.ScreenUpdating = False
Hirofumiさん共々、わざわざ改良版のご教示までして頂き、本当にありがとうございました。
ところが、初心者のため下記のコードの改造ができませんでした。
内容を解説してもらえませんか、よろしくお願いします。m(_ _)m
>"=IF(RC3>Sheet2!R1C10,""""," & _
>"VLOOKUP(RC1,Sheet2!C1:C10," & _
>"IF(RC3<=Sheet2!R1C2,2," & _
>"IF(RC3=OFFSET(Sheet2!R1C1,,MATCH(RC3,Sheet2!R1,1)-1)," & _
>"MATCH(RC3,Sheet2!R1,1),MATCH(RC3,Sheet2!R1,1)+1)),0))"

【24520】Re:表引きの定石をご教示下さい
回答  ウッシ  - 05/4/24(日) 0:41 -

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

R1C1形式の式です。
「R」は「Row」(行)、「C」は「Column」(列)を表します。

「RC3」は同じ行の3列目(C列)を指します。一番外側のIF文は重量がSheet2のJ1の値
より大きい場合、小さい場合の分岐処理をしています。
>"=IF(RC3>Sheet2!R1C10,""""," & _

全体としては「VLOOKUP」で目的の値を抽出しています。同じ行の1列目(A列)の値で検索
しています。表範囲はSheet2のA〜J列です。
>"VLOOKUP(RC1,Sheet2!C1:C10," & _

ここで「VLOOKUP」の「列番号」を求めていますが、
最初のIF分で重量がSheet2のB1の値より小さい場合は「2」として、大きい場合は
B1〜J1の値に等しい場合と、中間の場合とで結果を調整しています。
>"IF(RC3<=Sheet2!R1C2,2," & _
>"IF(RC3=OFFSET(Sheet2!R1C1,,MATCH(RC3,Sheet2!R1,1)-1)," & _
>"MATCH(RC3,Sheet2!R1,1),MATCH(RC3,Sheet2!R1,1)+1)),0))"

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