Excel VBA質問箱 IV

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

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


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

【50182】Vlookupについて 孝彦 07/7/13(金) 15:32 質問[未読]
【50183】Re:Vlookupについて かみちゃん 07/7/13(金) 15:50 発言[未読]
【50187】Re:Vlookupについて Hirofumi 07/7/13(金) 17:39 回答[未読]
【50424】Re:Vlookupについて 孝彦 07/7/24(火) 20:43 質問[未読]
【50428】Re:Vlookupについて Hirofumi 07/7/24(火) 21:25 回答[未読]
【50431】Re:Vlookupについて 孝彦 07/7/24(火) 21:59 お礼[未読]

【50182】Vlookupについて
質問  孝彦  - 07/7/13(金) 15:32 -

引用なし
パスワード
   こんにちは。過去ログを検索していて、下記のようなコードを見つけて
一部修正しようとしたのですが、そこまでVBAについての理解も知識もなく、
行き詰まってしまいました。
ご教授頂けましたら幸いです。

-----参考にしようとしたコード(投稿#6589でした)-----
Sub main()
  Dim vlookup_func As String
  Dim rng2 As Range
  With Worksheets("シート1")
   vlookup_func = "vlookup(rc[-1],シート1!" & _
           .Range(.Cells(1, 1), _
           .Cells(.Rows.Count, 1).End(xlUp)) _
           .Resize(, 2) _
           .Address(, , xlR1C1) & _
           ",2,false)"
   End With
  With Worksheets("シート2")
   Set rng2 = .Range(.Cells(1, 1), _
         .Cells(.Rows.Count, 1) _
         .End(xlUp)) _
         .Offset(0, 1)
   End With
  With rng2
    .Formula = "=if(iserror(" & _
         vlookup_func & "),""""," _
         & vlookup_func & ")"
    .Value = .Value
    End With
End Sub
-----ここまで-----

やろうとしていることは、
A〜E列までデータが存在するシート1のA列のどこかにある値と
シート2のG列の値を比較して、HITした場合は
シート2のC〜F列にシート1のB〜E列の値を貼り付け、
空白行になったら終了するというものです。

よろしくお願いします。

【50183】Re:Vlookupについて
発言  かみちゃん  - 07/7/13(金) 15:50 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>A〜E列までデータが存在するシート1のA列のどこかにある値と
>シート2のG列の値を比較して、HITした場合は
>シート2のC〜F列にシート1のB〜E列の値を貼り付け、

とりあえず、
    .Value = .Value
を消すと、
rng2のセル範囲に、数式が設定されますから、その数式が合っているか確認されましたか?
rng2のセル範囲は、
MsgBox rng2.Address
で確認できます。

> シート2のC〜F列にシート1のB〜E列の値を貼り付け

VLOOKUPは、複数のセル範囲の答えを返すことはできないということはおわかりいただいていますか?
そういうことからして、VLOOKUPを使おうとする発想を変えたほうがいいかもしれませんが、
いかがでしょうか?

【50187】Re:Vlookupについて
回答  Hirofumi  - 07/7/13(金) 17:39 -

引用なし
パスワード
   データが無いので試していませんが?
Sheet1、Sheet2共に列見出しが有る物とします
Sheet1、Sheet2共に比較する列をKeyとして整列されます
Sheet1、Sheet2に共通する比較値が有る場合は、
Sheet2のC〜F列にSheet1のB〜E列の値を貼り付け

Option Explicit
Option Compare Text

Public Sub DataMatch()

  'Sheet1のデータ列数(A列〜E列)
  Const clngColumns1 As Long = 5
  'Sheet1の比較する列の列位置(基準セル位置からの列Offset)
  Const clngKeys1 As Long = 0
  
  'Sheet2のデータ列数(C列〜G列)
  Const clngColumns2 As Long = 5
  'Sheet2の比較する列の列位置(基準セル位置からの列Offset)
  Const clngKeys2 As Long = 4
  
  Dim i As Long
  Dim j As Long
  Dim lngStart As Long
  Dim rngList1 As Range
  Dim vntList1 As Variant
  Dim lngRows1 As Long
  Dim rngList2 As Range
  Dim vntList2 As Variant
  Dim lngRows2 As Long
  Dim strProm As String

  'Sheet1のA1を基準とします
  Set rngList1 = Worksheets("Sheet1").Cells(1, "A")
  
  'Sheet2のD1を基準とする
  Set rngList2 = Worksheets("Sheet2").Cells(1, "C")
  
  '画面更新を停止
  Application.ScreenUpdating = False
  
  'Sheet1の基準に就いて
  With rngList1
    '行数を取得
    lngRows1 = .Offset(Rows.Count - .Row, _
              clngKeys1).End(xlUp).Row - .Row
    'データが無ければ
    If lngRows1 <= 0 Then
      strProm = rngList1.Value & "にデータが有りません"
      GoTo Wayout
    End If
    'データをA列で整列
    DataSort .Offset(1).Resize(lngRows1, _
              clngColumns1 + 1), .Offset(1, clngKeys1)
    '比較用配列にデータを取得
    vntList1 = .Offset(1, clngKeys1).Resize(lngRows1 + 1).Value
  End With

  'Sheet2基準に就いて
  With rngList2
    '行数を取得
    lngRows2 = .Offset(Rows.Count - .Row, _
              clngKeys2).End(xlUp).Row - .Row
    'データが無ければ
    If lngRows2 <= 0 Then
      strProm = rngList2.Value & "にデータが有りません"
      GoTo Wayout
    End If
    'データをG列で整列
    DataSort .Offset(1).Resize(lngRows2, _
              clngColumns2 + 1), .Offset(1, clngKeys2)
    '比較用配列にデータを取得
    vntList2 = .Offset(1, clngKeys2).Resize(lngRows2 + 1).Value
  End With
  
  'Sheet2の比較開始位置を設定
  lngStart = 1
  For i = 1 To lngRows1
    For j = lngStart To lngRows2
      'Matchiした場合
      If vntList1(i, 1) = vntList2(j, 1) Then
        'Sheet2のC〜F列にSheet1のB〜E列の値を貼り付け
        rngList2.Offset(j).Resize(, 4).Value _
            = rngList1.Offset(i, 1).Resize(, 4).Value
      Else
        'Sheet1の値がSheet2の値より小さい場合、Forを抜ける
        If vntList1(i, 1) < vntList2(j, 1) Then
          Exit For
        End If
      End If
    Next j
    'D列の比較開始位置を更新
    lngStart = j
  Next i
  
  strProm = "処理が完了しました"
  
Wayout:
  
  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngList1 = Nothing
  Set rngList2 = Nothing
  
  MsgBox strProm, vbInformation
  
End Sub

Private Sub DataSort(rngScope As Range, _
          rngKey As Range, _
          Optional lngOrientation As Long = xlTopToBottom)

  rngScope.Sort _
      Key1:=rngKey, Order1:=xlAscending, _
      Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
      Orientation:=lngOrientation, SortMethod:=xlStroke

End Sub

【50424】Re:Vlookupについて
質問  孝彦  - 07/7/24(火) 20:43 -

引用なし
パスワード
   ▼Hirofumi さん:
ありがとうございます。返信が遅くなりました。
書いて頂いたコードを使用してみました。
貼り付けはうまくいくのですが、
Sheet2のソート(R列まであります)がうまくいかず、
色々と試してみたのですが、うまくソートされませんでした。
解決方法をご教授ください。
よろしくお願いします。


>データが無いので試していませんが?
>Sheet1、Sheet2共に列見出しが有る物とします
>Sheet1、Sheet2共に比較する列をKeyとして整列されます
>Sheet1、Sheet2に共通する比較値が有る場合は、
>Sheet2のC〜F列にSheet1のB〜E列の値を貼り付け
>
>Option Explicit
>Option Compare Text
>
>Public Sub DataMatch()
>
>  'Sheet1のデータ列数(A列〜E列)
>  Const clngColumns1 As Long = 5
>  'Sheet1の比較する列の列位置(基準セル位置からの列Offset)
>  Const clngKeys1 As Long = 0
>  
>  'Sheet2のデータ列数(C列〜G列)
>  Const clngColumns2 As Long = 5
>  'Sheet2の比較する列の列位置(基準セル位置からの列Offset)
>  Const clngKeys2 As Long = 4
>  
>  Dim i As Long
>  Dim j As Long
>  Dim lngStart As Long
>  Dim rngList1 As Range
>  Dim vntList1 As Variant
>  Dim lngRows1 As Long
>  Dim rngList2 As Range
>  Dim vntList2 As Variant
>  Dim lngRows2 As Long
>  Dim strProm As String
>
>  'Sheet1のA1を基準とします
>  Set rngList1 = Worksheets("Sheet1").Cells(1, "A")
>  
>  'Sheet2のD1を基準とする
>  Set rngList2 = Worksheets("Sheet2").Cells(1, "C")
>  
>  '画面更新を停止
>  Application.ScreenUpdating = False
>  
>  'Sheet1の基準に就いて
>  With rngList1
>    '行数を取得
>    lngRows1 = .Offset(Rows.Count - .Row, _
>              clngKeys1).End(xlUp).Row - .Row
>    'データが無ければ
>    If lngRows1 <= 0 Then
>      strProm = rngList1.Value & "にデータが有りません"
>      GoTo Wayout
>    End If
>    'データをA列で整列
>    DataSort .Offset(1).Resize(lngRows1, _
>              clngColumns1 + 1), .Offset(1, clngKeys1)
>    '比較用配列にデータを取得
>    vntList1 = .Offset(1, clngKeys1).Resize(lngRows1 + 1).Value
>  End With
>
>  'Sheet2基準に就いて
>  With rngList2
>    '行数を取得
>    lngRows2 = .Offset(Rows.Count - .Row, _
>              clngKeys2).End(xlUp).Row - .Row
>    'データが無ければ
>    If lngRows2 <= 0 Then
>      strProm = rngList2.Value & "にデータが有りません"
>      GoTo Wayout
>    End If
>    'データをG列で整列
>    DataSort .Offset(1).Resize(lngRows2, _
>              clngColumns2 + 1), .Offset(1, clngKeys2)
>    '比較用配列にデータを取得
>    vntList2 = .Offset(1, clngKeys2).Resize(lngRows2 + 1).Value
>  End With
>  
>  'Sheet2の比較開始位置を設定
>  lngStart = 1
>  For i = 1 To lngRows1
>    For j = lngStart To lngRows2
>      'Matchiした場合
>      If vntList1(i, 1) = vntList2(j, 1) Then
>        'Sheet2のC〜F列にSheet1のB〜E列の値を貼り付け
>        rngList2.Offset(j).Resize(, 4).Value _
>            = rngList1.Offset(i, 1).Resize(, 4).Value
>      Else
>        'Sheet1の値がSheet2の値より小さい場合、Forを抜ける
>        If vntList1(i, 1) < vntList2(j, 1) Then
>          Exit For
>        End If
>      End If
>    Next j
>    'D列の比較開始位置を更新
>    lngStart = j
>  Next i
>  
>  strProm = "処理が完了しました"
>  
>Wayout:
>  
>  '画面更新を再開
>  Application.ScreenUpdating = True
>  
>  Set rngList1 = Nothing
>  Set rngList2 = Nothing
>  
>  MsgBox strProm, vbInformation
>  
>End Sub
>
>Private Sub DataSort(rngScope As Range, _
>          rngKey As Range, _
>          Optional lngOrientation As Long = xlTopToBottom)
>
>  rngScope.Sort _
>      Key1:=rngKey, Order1:=xlAscending, _
>      Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
>      Orientation:=lngOrientation, SortMethod:=xlStroke
>
>End Sub

【50428】Re:Vlookupについて
回答  Hirofumi  - 07/7/24(火) 21:25 -

引用なし
パスワード
   >Sheet2のソート(R列まであります)がうまくいかず、
>色々と試してみたのですが、うまくソートされませんでした。
>解決方法をご教授ください。

ソートが上手く行かないとは、どの様な現象でしょうか?

Sheet2のH〜R列がソートされないという事でしたら以下の様に変更して下さい

  'Sheet2のデータ列数(C列〜G列)
  Const clngColumns2 As Long = 5

の部分を

  'Sheet2のデータ列数(C列〜R列)
  Const clngColumns2 As Long = 16

とします

【50431】Re:Vlookupについて
お礼  孝彦  - 07/7/24(火) 21:59 -

引用なし
パスワード
   ▼Hirofumi さん:
ありがとうございました。
おかげさまでうまくいきました!
本当に助かりました。


>>Sheet2のソート(R列まであります)がうまくいかず、
>>色々と試してみたのですが、うまくソートされませんでした。
>>解決方法をご教授ください。
>
>ソートが上手く行かないとは、どの様な現象でしょうか?
>
>Sheet2のH〜R列がソートされないという事でしたら以下の様に変更して下さい
>
>  'Sheet2のデータ列数(C列〜G列)
>  Const clngColumns2 As Long = 5
>
>の部分を
>
>  'Sheet2のデータ列数(C列〜R列)
>  Const clngColumns2 As Long = 16
>
>とします

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