| |
シート名 元データ
A B C D E
1 場所 保育所
2 項目ID B501 B502
3 年 2002年 2003年 2002年 2003年
4 松戸市 35 54 35 54
5 船橋市 21 35 21 35
6 市川市 15 23 15 23
結合セル
B1:E1
B2:C2
D2:E2
シート名 更新用データ
A B
1 場所 保育所
2 項目ID B501
3 年 2004年
4 松戸市 25
5 船橋市 45
6 市川市 31
上記条件の時、下記コードで試してみました。
Sub sample()
Dim v, x, xi
Dim r1 As Range, r2 As Range, r3 As Range
Dim flg As Boolean
Dim a As String
With Sheets("更新用データ")
v = Application.Transpose(.Range("b1:b3").Value)
x = .Range("a4", .Range("a65536").End(xlUp)).Value
End With
With Sheets("元データ")
Set r1 = .Rows(1).Find(What:=v(1), LookIn:=xlValues _
, LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not r1 Is Nothing Then
Set r1 = r1.MergeArea
Set r2 = r1.EntireColumn.Rows(2).Find(What:=v(2))
If Not r2 Is Nothing Then
Set r2 = r2.MergeArea
Set r3 = r2.EntireColumn.Rows(3).Find(What:=v(3))
If r3 Is Nothing Then
Set r3 = r2.Offset(1).Offset(, r2.Columns.Count).Resize(, 1)
If Intersect(r3, r1.EntireColumn) Is Nothing Then flg = True
r3.EntireColumn.Insert
For Each xi In x
If IsError(Application.Match(xi, .Columns("a"), 0)) Then _
.Range("a65536").End(xlUp).Offset(1).Value = xi
Next xi
With r3.Offset(, -1).Resize(.Range("a65536").End(xlUp).Row - 2)
.Formula = "=VLOOKUP(A3,更新用データ!A:B,2,0)"
.Value = .Value
End With
r2.Resize(, r2.Columns.Count + 1).Merge
If flg Then r1.Resize(, r1.Columns.Count + 1).Merge
Set r3 = Nothing
a = "更新OK"
Else
a = v(3) & " 有"
End If
Set r2 = Nothing
Else
a = v(2) & " 無"
End If
Set r1 = Nothing
Else
a = v(1) & " 無"
End If
End With
MsgBox a
End Sub
やはり結合セルがあるとメンドくさいです。
#いや、もっとスマートな方法があるとは思うのですが...
|
|
Ned
- 06/7/9(日) 18:32 -
