| |
▼seya さん：
>Sheet1のB1セルの数値が、Sheet2のB列の数値で一致するセルがあった場合、Sheet１のB1を含むその行を、Sheet2の一致した行に上書きするにはどうしたらいいのでしょうか。 よろしくお願いします。
こういったMatchingの方法はいろいろありますが･･･
とりあえず、基本的なMatchingアルゴリズムを書いておきます。
双方のデータをSortしてから、総当りでMatchingしているものですが、
配列を用いているため、高速なはずです。
他に、高速なものとしてはDictionaryを用いたものとかあります。
興味があったらチャレンジしてみては？
Const MAX_LONG = &H7FFFFFFF
Sub test1()
Dim rngList1 As Range
Dim rngList2 As Range
Dim rngTemp1 As Range
Dim rngTemp2 As Range
Dim lngRowC1 As Long
Dim lngRowC2 As Long
Dim vntList1 As Variant
Dim vntList2 As Variant
Dim lngUCol1 As Long
Dim i As Long, j As Long, k As Long
'Sheet1
Set rngList1 = Worksheets("Sheet1").Cells(1).CurrentRegion
With rngList1
'B列で昇順Sort
.Sort Key1:=.Item(2), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, _
SortMethod:=xlStroke, DataOption1:=xlSortNormal
lngRowC1 = .Rows.Count
'Matching漏れをなくすため、B列の最終行にLong型の最大値を付与
Set rngTemp1 = .Item(2).Offset(lngRowC1)
rngTemp1.Value = MAX_LONG
'配列に代入
vntList1 = .Resize(lngRowC1 + 1).Value
End With
lngUCol1 = UBound(vntList1, 2)
'Sheet2
Set rngList2 = Worksheets("Sheet2").Cells(1).CurrentRegion
With rngList2
'B列で昇順Sort
.Sort Key1:=.Item(2), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=True, Orientation:=xlTopToBottom, _
SortMethod:=xlStroke, DataOption1:=xlSortNormal
lngRowC2 = .Rows.Count
'Matching漏れをなくすため、B列の最終行にLong型の最大値を付与
Set rngTemp2 = .Item(2).Offset(lngRowC2)
rngTemp2.Value = MAX_LONG
Set rngList2 = .Resize(lngRowC2 + 1, lngUCol1)
'配列に代入
vntList2 = rngList2.Value
End With
i = 1
j = 1
'Matching
Do
Select Case vntList1(i, 2)
Case Is < vntList2(j, 2)
i = i + 1
Case Is = vntList2(j, 2)
'値のコピー
For k = 1 To lngUCol1
vntList2(j, k) = vntList1(i, k)
Next k
j = j + 1
Case Is > vntList2(j, 2)
j = j + 1
End Select
Loop Until i > lngRowC1 + 1 Or j > lngRowC2 + 1
'結果の出力
rngList2.Value = vntList2
'Temp数字のクリア
rngTemp1.ClearContents
rngTemp2.ClearContents
End Sub
|
|
ちゃっぴ
- 04/10/24(日) 13:37 -
