Excel VBA質問箱 IV

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

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


18121 / 76738 ←次へ | 前へ→

【64060】Re:ご協力お願いします。
回答  Hirofumi  - 10/1/14(木) 12:25 -

引用なし
パスワード
   けち付ける様で申し訳ありませんが?

Dictionaryは、1個で善い様な気がします?
前月分のKeyをDictionaryに登録する時間が無駄に成る様な気がしますが?
尚、セルの入出力の位置は、「初心者さん - 10/1/12(火) 22:19 -」に合わせました

Option Explicit

Sub datacheck_2()

  Dim dic2 As Object
  Dim r1 As Long, r2 As Long
  Dim v1 As Long, v2 As Long
  Dim key As String
 
  Dim lngCheck() As Long
  Dim rngMark As Range
  
  Set dic2 = CreateObject("Scripting.Dictionary")
 
  For r2 = 2 To [O1].End(xlDown).Row
    key = Cells(r2, 15).Value & "_" & Cells(r2, 16).Value
    dic2(key) = r2
  Next r2
  ReDim lngCheck(dic2.Count - 1)
  
  For r1 = 2 To [B1].End(xlDown).Row
    key = Cells(r1, 2).Value & "_" & Cells(r1, 3).Value
    If dic2.Exists(key) Then
      r2 = dic2(key)
      v1 = Cells(r1, 7).Value
      v2 = Cells(r2, 20).Value
      If v1 <> v2 Then
        Cells(r1, 9).Value = "金額変更"
        Cells(r1, 10).Value = v2 - v1
        Cells(r2, 22).Value = "金額変更"
        Cells(r2, 23).Value = v2 - v1
      End If
      lngCheck(r2 - 2) = 1
    Else
      Cells(r1, 9).Value = "削除"
    End If
  Next r1
 
  For r2 = 0 To UBound(lngCheck)
    If lngCheck(r2) = 0 Then
      Cells(r2 + 2, 22).Value = "追加"
    End If
  Next r2
 
  Set dic2 = Nothing
 
End Sub
0 hits

【64046】ご協力お願いします。 初心者 10/1/12(火) 22:19 質問
【64047】Re:ご協力お願いします。 Hirofumi 10/1/12(火) 23:49 回答
【64048】Re:ご協力お願いします。 Hirofumi 10/1/13(水) 0:22 回答
【64052】Re:ご協力お願いします。 初心者 10/1/13(水) 16:57 質問
【64053】Re:ご協力お願いします。 Hirofumi 10/1/13(水) 19:05 回答
【64054】Re:ご協力お願いします。 初心者 10/1/13(水) 20:38 お礼
【64055】Re:ご協力お願いします。 ご参考 10/1/13(水) 23:13 発言
【64060】Re:ご協力お願いします。 Hirofumi 10/1/14(木) 12:25 回答
【64065】Re:ご協力お願いします。 初心者 10/1/14(木) 22:41 質問
【64066】Re:ご協力お願いします。 Hirofumi 10/1/14(木) 23:37 発言
【64067】Re:ご協力お願いします。 初心者 10/1/15(金) 8:52 発言
【64068】Re:ご協力お願いします。 Hirofumi 10/1/15(金) 13:05 発言
【64069】Re:ご協力お願いします。 Hirofumi 10/1/15(金) 13:13 発言
【64074】Re:ご協力お願いします。 初心者 10/1/16(土) 22:29 質問
【64075】Re:ご協力お願いします。 かみちゃん 10/1/16(土) 22:34 発言
【64076】Re:ご協力お願いします。 Hirofumi 10/1/16(土) 23:15 回答
【64077】Re:ご協力お願いします。 Hirofumi 10/1/16(土) 23:27 回答
【64078】Re:ご協力お願いします。 Hirofumi 10/1/16(土) 23:45 回答
【64079】Re:ご協力お願いします。 初心者 10/1/17(日) 1:01 発言
【64080】Re:ご協力お願いします。 Hirofumi 10/1/17(日) 8:56 回答
【64081】Re:ご協力お願いします。 Hirofumi 10/1/17(日) 9:47 回答
【64085】Re:ご協力お願いします。 初心者 10/1/17(日) 12:41 発言
【64086】Re:ご協力お願いします。 Hirofumi 10/1/17(日) 16:10 回答
【64088】Re:ご協力お願いします。 初心者 10/1/17(日) 23:30 発言
【64089】Re:ご協力お願いします。 Hirofumi 10/1/18(月) 7:04 回答
【64090】Re:ご協力お願いします。 Hirofumi 10/1/18(月) 7:16 発言
【64102】Re:ご協力お願いします。 初心者 10/1/19(火) 9:26 お礼
【64082】Re:ご協力お願いします。 かみちゃん 10/1/17(日) 10:01 発言

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