Excel VBA質問箱 IV

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

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


31561 / 76738 ←次へ | 前へ→

【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

4 hits

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

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