Excel VBA質問箱 IV

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

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


8539 / 76732 ←次へ | 前へ→

【73763】Re:表の比較
発言  UO3  - 13/2/10(日) 19:51 -

引用なし
パスワード
   ▼t−k さん:

こんばんは

>素人なのでわかりやすく教えてください

わかりやすくはないと思いますが・・・
必要なら、主要なところにコメントをつけますけど、とりあえず。

アップされたコードは全く読んでいません。
提示されたレイアウトだけを見て処理しています。

Sheet2に転記できなかったSheet1のセルに色づけするとともに、
Sheet2にしか存在しなかったものについてもSHeet2側のセルに色づけしています。

Sub Sample()
  Dim fSh As Worksheet
  Dim tSh As Worksheet
  Dim fDic As Object
  Dim tDic As Object
  Dim c As Range
  Dim dt As Double
  Dim com As String
  Dim dKey As Variant
  
  Application.ScreenUpdating = False
  
  Set fDic = CreateObject("Scripting.Dictionary")
  Set tDic = CreateObject("Scripting.Dictionary")

  Set fSh = Sheets("Sheet1")
  Set tSh = Sheets("Sheet2")
  
  fSh.Cells.Interior.ColorIndex = xlNone
  tSh.Cells.Interior.ColorIndex = xlNone
  
  With fSh.Range("A1").CurrentRegion
    For Each c In .Offset(1, 2).Resize(.Rows.Count - 1, .Columns.Count - 2)
      dt = fSh.Cells(1, c.Column).Value2
      com = fSh.Cells(c.Row, "A").Value
      fDic(com & dt) = VBA.Array(c.Value, c.Address(External:=True))
    Next
  End With
  
  With tSh.Range("A1").CurrentRegion
    For Each c In .Offset(1, 2).Resize(.Rows.Count - 1, .Columns.Count - 2)
      dt = tSh.Cells(1, c.Column).Value2
      com = tSh.Cells(c.Row, "A").Value
      tDic(com & dt) = VBA.Array(c.Value, c.Address(External:=True))
    Next
  End With
      
  'Sheet1からSheet2への転記
  
  For Each dKey In fDic
    If tDic.exists(dKey) Then
      Range(tDic(dKey)(1)).Value = Range(fDic(dKey)(1)).Value
    Else
      Range(fDic(dKey)(1)).Interior.ColorIndex = 3
    End If
  Next
  
  'Sheet2 にしか存在しない項目の色つけ
  
  For Each dKey In tDic
    If Not fDic.exists(dKey) Then Range(tDic(dKey)(1)).Interior.ColorIndex = 3
  Next
  
  tSh.Activate
  Application.ScreenUpdating = True
  MsgBox "転記完了"
  
End Sub
505 hits

【73761】表の比較 t−k 13/2/10(日) 15:38 質問
【73762】Re:表の比較 UO3 13/2/10(日) 19:22 発言
【73763】Re:表の比較 UO3 13/2/10(日) 19:51 発言
【73766】Re:表の比較 t−k 13/2/10(日) 22:56 発言
【73767】Re:表の比較 UO3 13/2/11(月) 6:46 発言
【75126】Re:表の比較 T-k 13/12/14(土) 0:02 質問
【75127】Re:表の比較 γ 13/12/14(土) 6:36 発言
【75133】Re:表の比較 T-k 13/12/17(火) 0:55 発言
【75134】Re:表の比較 γ 13/12/17(火) 6:35 発言
【75135】Re:表の比較 T-k 13/12/18(水) 0:28 発言
【75138】Re:表の比較 γ 13/12/18(水) 23:17 発言
【75141】Re:表の比較 T-k 13/12/20(金) 0:36 発言
【75143】Re:表の比較 γ 13/12/20(金) 7:16 発言
【75147】Re:表の比較 T-k 13/12/20(金) 23:50 お礼
【73768】Re:表の比較 UO3 13/2/11(月) 14:08 発言
【73770】Re:表の比較 t−k 13/2/12(火) 23:38 お礼
【73780】Re:表の比較 UO3 13/2/13(水) 19:30 発言
【81386】Re:表の比較 T-K 20/7/13(月) 23:33 質問[未読]
【81388】Re:表の比較 γ 20/7/14(火) 5:43 発言[未読]
【81393】Re:表の比較 T-K 20/7/14(火) 19:54 発言[未読]
【81394】Re:表の比較 γ 20/7/15(水) 9:15 回答[未読]
【81395】Re:表の比較 T-K 20/7/15(水) 17:45 お礼[未読]
【81396】Re:表の比較 マナ 20/7/15(水) 21:02 発言[未読]
【81398】Re:表の比較 マナ 20/7/15(水) 21:40 発言[未読]
【81397】Re:表の比較 マナ 20/7/15(水) 21:04 発言[未読]
【81399】Re:表の比較 T-K 20/7/15(水) 23:57 発言[未読]
【81400】Re:表の比較 マナ 20/7/16(木) 21:05 発言[未読]
【81410】Re:表の比較 T-K 20/7/23(木) 23:51 発言[未読]
【81412】Re:表の比較 マナ 20/7/24(金) 11:03 発言[未読]
【81415】Re:表の比較 マナ 20/7/24(金) 11:51 発言[未読]
【81429】Re:表の比較 T-K 20/7/29(水) 23:31 発言[未読]
【81433】Re:表の比較 マナ 20/7/30(木) 19:30 発言[未読]
【81434】Re:表の比較 マナ 20/7/30(木) 20:20 発言[未読]
【81435】Re:表の比較 T–K 20/8/1(土) 12:29 お礼[未読]

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