Excel VBA質問箱 IV

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

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


15957 / 76734 ←次へ | 前へ→

【66251】Re:複数のシートの統合について
発言  かみちゃん E-MAIL  - 10/8/12(木) 14:17 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>> ようやく仕様が理解できましたので、検討します。
>> 少しお時間をいただければと思います。
>> できるだけ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行目より下にもデータが追加されていくものとしています。
そうではない場合、一覧シートのシートレイアウトを教えてください。

また、動作確認もしてありますので、必要であれば、確認ファイルを差し上げ
ることも可能です。

1 hits

【66198】複数のシートの統合について kamaboko 10/8/8(日) 15:57 質問
【66199】Re:複数のシートの統合について かみちゃん 10/8/8(日) 16:40 発言
【66200】Re:複数のシートの統合について kamaboko 10/8/8(日) 17:27 お礼
【66201】Re:複数のシートの統合について かみちゃん 10/8/8(日) 20:07 発言
【66202】Re:複数のシートの統合について kamaboko 10/8/8(日) 21:29 質問
【66203】Re:複数のシートの統合について kamaboko 10/8/8(日) 21:49 発言
【66204】Re:複数のシートの統合について かみちゃん 10/8/8(日) 22:11 発言
【66207】Re:複数のシートの統合について kamaboko 10/8/8(日) 23:24 お礼
【66205】Re:複数のシートの統合について kamaboko 10/8/8(日) 22:34 お礼
【66206】Re:複数のシートの統合について かみちゃん 10/8/8(日) 22:54 発言
【66209】Re:複数のシートの統合について kamaboko 10/8/9(月) 19:49 質問
【66210】Re:複数のシートの統合について かみちゃん 10/8/9(月) 20:06 発言
【66211】Re:複数のシートの統合について kamaboko 10/8/10(火) 8:22 発言
【66212】Re:複数のシートの統合について かみちゃん 10/8/10(火) 8:52 発言
【66214】Re:複数のシートの統合について kamabako 10/8/10(火) 13:19 発言
【66216】Re:複数のシートの統合について かみちゃん 10/8/10(火) 13:48 発言
【66220】Re:複数のシートの統合について kamabako 10/8/10(火) 15:01 発言
【66221】Re:複数のシートの統合について かみちゃん 10/8/10(火) 15:20 発言
【66227】Re:複数のシートの統合について kamaboko 10/8/11(水) 1:47 発言
【66228】Re:複数のシートの統合について かみちゃん 10/8/11(水) 5:58 発言
【66230】Re:複数のシートの統合について kamaboko 10/8/11(水) 8:18 発言
【66231】Re:複数のシートの統合について かみちゃん 10/8/11(水) 8:29 発言
【66241】Re:複数のシートの統合について kamaboko 10/8/11(水) 19:08 発言
【66242】Re:複数のシートの統合について かみちゃん 10/8/11(水) 19:13 発言
【66245】Re:複数のシートの統合について kamaboko 10/8/11(水) 22:40 発言
【66251】Re:複数のシートの統合について かみちゃん 10/8/12(木) 14:17 発言
【66261】Re:複数のシートの統合について kamaboko 10/8/13(金) 2:05 発言
【66262】Re:複数のシートの統合について かみちゃん 10/8/13(金) 5:38 発言
【66263】Re:複数のシートの統合について kamabako 10/8/13(金) 10:03 発言
【66264】Re:複数のシートの統合について kamabako 10/8/13(金) 10:15 発言
【66265】Re:複数のシートの統合について かみちゃん 10/8/13(金) 10:26 発言
【66266】Re:複数のシートの統合について kamabako 10/8/13(金) 11:36 発言
【66267】Re:複数のシートの統合について かみちゃん 10/8/13(金) 13:11 発言
【66268】Re:複数のシートの統合について kamaboko 10/8/14(土) 0:01 お礼

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