| |
▼ぶらっと さん：
>▼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")
> 'シート１の列数取得
> cols = .UsedRange.Cells(.UsedRange.Cells.Count).Column
> ReDim b(1 To 1, 1 To cols) 'シート１にない場合の転記行スケルトン
> End With
>
> With Sheets("Sheet2")
> 'シート２のA1からA列のデータ最終行までのセルを１つずつ取り出す
> For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
> 'シート２のキーの重複は無視（処理しない）
> If Not dic.exists(c.Value) Then
> 'シート１のD列に、その値があるかどうか
> cnt = WorksheetFunction.CountIf(sh1.Columns("D"), c.Value)
> dic(c.Value) = Array(fIdx, cnt, 0)
> If cnt > 0 Then
> fIdx = fIdx + cnt 'シート２にあれば
> 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列のデータ最終行までのセルを１つずつ取り出す
> For Each c In .Range("D1", .Range("D" & .Rows.Count).End(xlUp))
> 'もし辞書にあれば（シート２にあれば）１行分のイメージを配列に格納
> 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
ぶらっと さん
私の確認不足でお手間を取らせて申し訳ございませんでした。
また、お返事大変感謝しております。
すぐには理解できないコードですが、明日からにらめっこして勉強させていただきたいです。
こちらのコードでは、上記新規質問させて頂いたものには対応難しいですよね？
|
|
kiki
- 12/8/7(火) 20:54 -
