| |
こんにちは。かみちゃん です。
>> ようやく仕様が理解できましたので、検討します。
>> 少しお時間をいただければと思います。
>> できるだけkamabokoさんのコードをベースにします
>>
> 本当にお手間を取らせました。
kamabokoさんが提示されたコードをベースにしようとしましたが、
結果としてほとんど原型をとどめないものになってしまいました。
他にももっと効率のようものがあるとは思いますが、以下のような
感じで処理できると思います。
Option Explicit
Option Base 1
Sub 支店別シート統合()
Dim シート名 As Variant
Dim 開始セル As String
Dim i As Long
Dim WS1 As Worksheet, WS2 As Worksheet
Dim v1 As Variant, v2 As Variant
Dim ii As Long, jj As Long, kk As Long
Dim i_Max As Long
Dim m As Variant
シート名 = Array("札幌", "仙台", "新潟", "中央", "品川", "新宿", "世田谷", "港", "さいたま", "千葉", "横浜", "静岡", "名古屋", "京都", "大阪")
開始セル = "$A$3"
Set WS1 = Nothing
On Error Resume Next
Set WS1 = Sheets("一覧")
On Error GoTo 0
If WS1 Is Nothing Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "一覧"
End If
'---- 既存の一覧シートの値を取得
Sheets("一覧").Select
With Range(開始セル).CurrentRegion
v1 = .Resize(30 * 15, .Columns.Count + 1).Value
End With
jj = UBound(v1, 1)
kk = UBound(v1, 2)
For ii = 1 To jj
'B列とC列（C列〜F列の結合セル）の値をキーとして取得
v1(ii, kk) = v1(ii, 2) & "_" & v1(ii, 3)
If v1(ii, 2) = "" And v1(ii, 3) = "" Then
i_Max = ii
Exit For
End If
Next
'----
'---- 転記対象データの取得
For i = 1 To 15
Set WS2 = Nothing
On Error Resume Next
Set WS2 = Sheets(シート名(i))
On Error GoTo 0
If Not WS2 Is Nothing Then
WS2.Activate
Range(開始セル).CurrentRegion.Select
If Cells(Selection.Rows.Count + 1, 2).End(xlUp).Row > 3 Then
v2 = Range(開始セル).CurrentRegion.Value
jj = UBound(v2, 1)
For ii = 1 To jj
'B列かC列（C列〜F列の結合セル）のいずれかに値がある場合
If v2(ii, 2) <> "" Or v2(ii, 3) <> "" Then
'B列とC列（C列〜F列の結合セル）の組み合わせを一覧シートのキー（組み合わせ）から検索
m = Application.Match(v2(ii, 2) & "_" & v2(ii, 3), _
Application.WorksheetFunction.Index(v1, 0, kk), 0)
If Not IsNumeric(m) Then
v1(i_Max, 1) = v2(ii, 1)
v1(i_Max, 2) = v2(ii, 2)
v1(i_Max, 3) = v2(ii, 3)
v1(i_Max, 7) = v2(ii, 7)
v1(i_Max, 8) = v2(ii, 8)
v1(i_Max, 9) = v2(ii, 9)
v1(i_Max, kk) = v2(ii, 2) & "_" & v2(ii, 3)
i_Max = i_Max + 1
End If
End If
Next
Else
MsgBox WS2.Name & "シートにはデータがありません"
End If
End If
Next
'----
'---- 一覧シートの出力
Sheets("一覧").Activate
With Range(開始セル).CurrentRegion
.Resize(i_Max).Value = v1
End With
'----
End Sub
なお、一覧シートは、支店シートと同じフォーマットとし、
33行目より下にもデータが追加されていくものとしています。
そうではない場合、一覧シートのシートレイアウトを教えてください。
また、動作確認もしてありますので、必要であれば、確認ファイルを差し上げ
ることも可能です。
|
|
かみちゃん
- 10/8/12(木) 14:17 -
