Excel VBA質問箱 IV

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

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


9882 / 76734 ←次へ | 前へ→

【72409】Re:再:2つのシートのデータを照合し列が一致したら転記したい
お礼  kiki  - 12/8/7(火) 20:54 -

引用なし
パスワード
   ▼ぶらっと さん:
>▼kiki さん:
>
>なぁるほど。そういう要件だったんだ。
>じゃぁ、そちらのコードの添削は、この板の回答者さんにおまかせして
>あちらで回答したコードを踏まえて以下。データ量が多ければ効果ありかな?
>参考まで。
>
> Sub Sample()
>  Dim c As Range
>  Dim v() As Variant
>  Dim keyV() As String
>  Dim b() As Variant
>  Dim cols As Long
>  Dim j As Long
>  Dim dic As Object
>  Dim sh1 As Worksheet
>  Dim cnt As Long
>  Dim fIdx As Long
>  Dim mIdx As Long
>  Dim w As Variant
>  Dim n As Long
>  
>  Set dic = CreateObject("Scripting.Dictionary")
>  Set sh1 = Sheets("Sheet1")
>  fIdx = 1  '転記用配列行カウンター
>  ReDim v(1 To Rows.Count)      '転記用配列を最大行で準備
>  ReDim keyV(1 To Rows.Count, 1 To 1) 'キー列用配列
>  
>  With Sheets("Sheet1")
>    'シート1の列数取得
>    cols = .UsedRange.Cells(.UsedRange.Cells.Count).Column
>    ReDim b(1 To 1, 1 To cols) 'シート1にない場合の転記行スケルトン
>  End With
>  
>  With Sheets("Sheet2")
>    'シート2のA1からA列のデータ最終行までのセルを1つずつ取り出す
>    For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>      'シート2のキーの重複は無視(処理しない)
>      If Not dic.exists(c.Value) Then
>        'シート1のD列に、その値があるかどうか
>        cnt = WorksheetFunction.CountIf(sh1.Columns("D"), c.Value)
>        dic(c.Value) = Array(fIdx, cnt, 0)
>        If cnt > 0 Then
>          fIdx = fIdx + cnt 'シート2にあれば
>        Else
>          v(fIdx) = b       'なければ行スケルトン
>          keyV(fIdx, 1) = c.Value 'キー列
>          mIdx = fIdx '配列セット行の最大数
>          fIdx = fIdx + 1
>        End If
>      End If
>    Next
>    
>  End With
>
>  With Sheets("Sheet1")
>    'シート1のD1からD列のデータ最終行までのセルを1つずつ取り出す
>    For Each c In .Range("D1", .Range("D" & .Rows.Count).End(xlUp))
>      'もし辞書にあれば(シート2にあれば)1行分のイメージを配列に格納
>      If dic.exists(c.Value) Then
>        w = dic(c.Value)
>        n = w(0) + w(2)
>        v(n) = c.EntireRow.Resize(, cols).Value
>        '配列セット行の最大値
>        mIdx = WorksheetFunction.Max(n, mIdx)
>        w(2) = w(2) + 1
>        dic(c.Value) = w
>        If w(2) = 1 Then keyV(n, 1) = c.Value  'キー列用配列
>      End If
>    Next
>  End With
>
>  With Sheets("Sheet2")
>    Cells.ClearContents     '最初に転記領域のクリア
>    .Range("A1").Resize(mIdx).Value = keyV 'キー列セット
>    ReDim Preserve v(1 To mIdx)       '転記用配列を実際の行数分に圧縮
>    .Range("C1").Resize(mIdx, cols).Value = _
>      WorksheetFunction.Transpose(WorksheetFunction.Transpose(v))
>    .Select
>  End With
>
>
>  MsgBox "転記終了"
>
>
> End Sub

ぶらっと さん

私の確認不足でお手間を取らせて申し訳ございませんでした。
また、お返事大変感謝しております。
すぐには理解できないコードですが、明日からにらめっこして勉強させていただきたいです。

こちらのコードでは、上記新規質問させて頂いたものには対応難しいですよね?
8 hits

【72393】2つのシートのデータを照合し列が一致したら転記したい kiki 12/8/1(水) 23:50 質問
【72394】Re:2つのシートのデータを照合し列が一致... UO3 12/8/2(木) 10:12 発言
【72396】Re:2つのシートのデータを照合し列が一致... kiki 12/8/2(木) 22:12 発言
【72395】Re:2つのシートのデータを照合し列が一致... ドカ 12/8/2(木) 14:28 回答
【72397】Re:2つのシートのデータを照合し列が一致... kiki 12/8/2(木) 22:17 お礼
【72400】再:2つのシートのデータを照合し列が一致... kiki 12/8/6(月) 22:07 質問
【72401】Re:再:2つのシートのデータを照合し列が一... UO3 12/8/7(火) 6:23 発言
【72407】Re:再:2つのシートのデータを照合し列が一... kiki 12/8/7(火) 20:48 質問
【72420】Re:再:2つのシートのデータを照合し列が一... UO3 12/8/8(水) 21:02 発言
【72427】Re:再:2つのシートのデータを照合し列が一... kiki 12/8/8(水) 22:21 お礼
【72402】Re:再:2つのシートのデータを照合し列が一... UO3 12/8/7(火) 6:36 発言
【72403】Re:再:2つのシートのデータを照合し列が一... UO3 12/8/7(火) 6:39 発言
【72404】Re:再:2つのシートのデータを照合し列が一... ぶらっと 12/8/7(火) 10:09 回答
【72409】Re:再:2つのシートのデータを照合し列が一... kiki 12/8/7(火) 20:54 お礼
【72405】Re:再:2つのシートのデータを照合し列が一... kanabun 12/8/7(火) 14:25 発言
【72411】Re:再:2つのシートのデータを照合し列が一... kiki 12/8/7(火) 22:25 お礼
【72410】再:2つのシートのデータを照合し列が一致... kiki 12/8/7(火) 21:11 質問
【72412】Re:再:2つのシートのデータを照合し列が... kanabun 12/8/8(水) 12:51 発言
【72413】Re:再:2つのシートのデータを照合し列が... kanabun 12/8/8(水) 13:34 発言
【72414】Re:再:2つのシートのデータを照合し列が... kanabun 12/8/8(水) 14:34 発言
【72415】Re:再:2つのシートのデータを照合し列が... kanabun 12/8/8(水) 14:46 発言
【72416】Re:再:2つのシートのデータを照合し列が... kanabun 12/8/8(水) 17:07 発言
【72418】Re:再:2つのシートのデータを照合し列が... kanabun 12/8/8(水) 17:17 発言
【72419】Re:再:2つのシートのデータを照合し列が... kiki 12/8/8(水) 20:41 質問
【72422】Re:再:2つのシートのデータを照合し列が... kanabun 12/8/8(水) 21:10 回答
【72426】Re:再:2つのシートのデータを照合し列が... kiki 12/8/8(水) 22:13 お礼
【72430】Re:再:2つのシートのデータを照合し列が... kanabun 12/8/9(木) 14:26 発言
【72437】Re:再:2つのシートのデータを照合し列が... kiki 12/8/9(木) 23:21 お礼
【72439】Re:再:2つのシートのデータを照合し列が... kanabun 12/8/10(金) 9:18 発言
【72421】Re:再:2つのシートのデータを照合し列が... kiki 12/8/8(水) 21:06 質問
【72431】Re:再:2つのシートのデータを照合し列が... kanabun 12/8/9(木) 14:42 発言
【72438】Re:再:2つのシートのデータを照合し列が... kiki 12/8/9(木) 23:22 お礼

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