Excel VBA質問箱 IV

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

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


41587 / 76732 ←次へ | 前へ→

【40224】Re:VBAデータの挿入の仕方
発言  Ned  - 06/7/9(日) 18:32 -

引用なし
パスワード
   シート名 元データ
    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

やはり結合セルがあるとメンドくさいです。
#いや、もっとスマートな方法があるとは思うのですが...
5 hits

【40183】VBAデータの挿入の仕方 あおし 06/7/7(金) 23:46 質問
【40185】Re:VBAデータの挿入の仕方 Ned 06/7/8(土) 0:06 発言
【40224】Re:VBAデータの挿入の仕方 Ned 06/7/9(日) 18:32 発言

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