エクセルシート1のA列とB列に、それぞれ、日付けと金額のデータが入っています。

また、エクセルシート2のA列とB列に、それぞれ、日付けと金額のデータが入っています。
エクセルシート1のC列に、次の場合分けで結果を返したいです。
①シート2に、日付けと金額の組み合わせが完全に一致するデータがある場合:一致する数
②シート2に、日付けは違うが、その違いは5日以内であり、それと金額の組み合わせが完全に一致するデータがある場合:一致する数と、"日付け違い"という文字列
③上記①②以外の場合:0
どうすればいいでしょうか?

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2014/03/01 13:41:16
  • 終了:2014/03/08 13:45:06

回答(1件)

id:language_and_engineering No.1

lang_and_engine回答回数170ベストアンサー獲得回数632014/03/01 18:22:04

ポイント200pt

できましたよ~。


Sub main()
    ' シート1の金額をキーに検索をかける
    
    Dim sheet1 As Worksheet
    Set sheet1 = Worksheets("Sheet1")
    
    y = 1
    continue_flag = True
    Do While continue_flag = True
    
        kingaku = sheet1.Cells(y, 2).Value
        
        If Len(kingaku) > 0 Then
            hiduke = sheet1.Cells(y, 1).Value
            
            ' この値でシート2に問い合わせる
            result = scan_sheet(hiduke, kingaku)
            
            ' 結果を書き込み
            sheet1.Cells(y, 3).Value = result
        
            ' 次の行へ
            y = y + 1
        Else
            ' 金額の行の終わり
            continue_flag = False
        End If
        
    Loop
    
End Sub


' シート2に問い合わせる
Function scan_sheet(hiduke, kingaku)

    Dim sheet2 As Worksheet
    Set sheet2 = Worksheets("Sheet2")
    
    ' 完全一致の個数
    cnt_icchi = 0
    
    ' 日付がずれたデータは一個しかないと仮定する。
    ' 日付がずれたデータが存在するかどうか
    zure_flag = False
    
    y = 1
    continue_flag = True
    Do While continue_flag = True
    
        cmp_kingaku = sheet2.Cells(y, 2).Value
        
        If Len(cmp_kingaku) > 0 Then
            cmp_hiduke = sheet2.Cells(y, 1).Value
            
            ' 完全一致か?
            If (cmp_kingaku = kingaku) And (cmp_hiduke = hiduke) Then
                cnt_icchi = cnt_icchi + 1
            End If
                            
            ' 金額だけ同じで,日付がずれたデータか?
            d1 = CDate(hiduke)
            d2 = CDate(cmp_hiduke)
                ' http://www.ken3.org/vba/backno/vba072.html
            d_diff = DateDiff("d", d1, d2)
                ' http://www.geocities.jp/cbc_vbnet/function/date.html
            If (cmp_kingaku = kingaku) And (Abs(d_diff) < 6) And (Abs(d_diff) > 0) Then   ' 5日以内
                ' ずれたデータが存在するとみなす
                zure_flag = True
            End If
            
            ' 次の行へ
            y = y + 1
        Else
            ' 金額の行の終わり
            continue_flag = False
        End If
    Loop

    ' 結果を返す・・・★
    scan_sheet = "完全一致の個数:" & cnt_icchi
    If zure_flag = True Then
        scan_sheet = scan_sheet & " 日付け違いあり"
    End If
    
End Function


C列に表示する文字列は,★の部分をお好みでカスタマイズして下さい。

他2件のコメントを見る
id:sacrifice225

ありがとうございます!ちょっとカスタマイズをためしてみます!

2014/03/01 20:48:21
id:sacrifice225

本当に有り難うございました。助かりました。

2014/03/01 21:40:07

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません