重複転送を防止したいのですが

質問

いつもお世話になっています。excelマクロについて質問させて下さい。
bookに入力用シートと集計シートがあります。一日のデーターを入力用シートに
入力し同シートにある”集計シートに転送ボタン”をクリックすると集計シートの
最終行の下に転送するようになっています。この転送ボタンをクリックすると
クリックした分だけ転送してしまい正常なデーターではなくなってしまいます。
転送ボタンを一日に一回しかクリック出来ないようにするか転送データーに
同じ日付があった場合は転送しないようにするにはどうすれば良いのでしょうか？
また、転送した後に間違いに気づいた場合手入力で集計データーを修正する
ようにメッセージを出す方法も教えて下さい。
よろしくお願いします。転送ボタンのマクロは以下の通りです。
Sub 転送()
Dim i As Long, R As Range
Set R = Sheets("入力用シート").Range("C5:C42")
With Sheets("集計シート")
i = .Range("b65536").End(xlUp).Row
.Cells(i + 1, 2).Resize(, 38).Value = Application.WorksheetFunction.Transpose(R.Value)
End With
End Sub

回答No.5

Wendy02 · ベストアンサー

こんにちは。

コピーしようとしているデータ C5 を[集計シート]のB列から探して、同じものがあれば、メッセージが出ます。また、すでに、重複がある場合も、同シートのB列の重複データを探しています。

Sub TransferData()
　　Dim i As Long, r As Range
　　Dim ret As Variant

　　Set r = Sheets("入力用シート").Range("C5:C42")

　　With Sheets("集計シート")
　　　　i = .Range("b65536").End(xlUp).Row

　　　　'入力シートの先頭の値を、集計シートの2列目から探す
　　　　ret = Application.Match(r.Cells(1), .Columns(2), 0)

　　　　If Not IsNumeric(ret) Then
　　　　　　.Cells(i + 1, 2).Resize(, 38).Value = _
　　　　　　Application.WorksheetFunction.Transpose(r.Value)
　　　　　　MsgBox "転送完了", vbInformation
　　　　Else
　　　　　　MsgBox "コピーしようとしてるデータは、重複していませんか？", vbQuestion
　　　　End If
'----------------------------------
　'重複チェック
　　　　Dim n As Range
　　　　Set n = .Range("B1", .Range("B65536").End(xlUp))
　　　　If Evaluate("MAX(COUNTIF(" & .Name & "!" & n.Address & "," & .Name & "!" & n.Address & "))") > 1 Then
　　　　　　MsgBox "すでに重複があります。", vbExclamation
　　　　End If
　'----------------------------------
　　End With
　　Set r = Nothing
End Sub

回答No.4

kmetu

> 教えて頂いたコードに変更してもエラーメッセージは出るのですが何度でも転送出来てしまいます。

Else
'転送のコード
MsgBox "転送間違いの場合は手動で訂正してください"
End If

上記の転送のコードのところにk-fumiさんの作成した転送用のコード(質問文に書かれている)を記載しているでしょうか

お礼

ありがとうございます。
ご指摘の通り質問に書いたコードにkmetuさんから頂いたコードを
貼り付けただけで実行していました。申し訳ありません。出来るよう
になりました。
何度もありがとうございました。感謝致します。

回答No.3

kmetu

> 入力シートのC5は日付なのですが集計シートの日付はB6から下になるのですが。

ということでしたら

If Sheets("集計シート").Range("B" & Sheets("集計シート").Range("B6").End(xlDown).Row) = Range("C5") Then

に変更してください

Range("B" & Sheets("集計シート").Range("B6").

上記のRangeの指定部分を集計シートにあわせるということになります。

お礼

ありがとうございます。
教えて頂いたコードに変更してもエラーメッセージは出るのですが何度でも転送出来てしまいます。

回答No.2

KURUMITO

最後のEnd Withの次の行に以下を追加してはどうでしょう。
Sheets("入力用シート").Range("C5:C42").Clear
つまりは、入力の操作をすれば転送され、元のデータはなくなるということです。

お礼

とても早い回答ありがとうございます。
入力データーをクリアーすることができました。
二重転送をかなり防げると思います。

回答No.1

kmetu

C5に日付が入っているとして以下のマクロでいかがでしょう

If Sheets("集計シート").Range("C" & Sheets("集計シート").Range("C5").End(xlDown).Row) = Range("C5") Then
MsgBox "データが重複しています"
Else
'転送のコード
MsgBox "転送間違いの場合は手動で訂正してください"
End If

お礼

とても早い回答ありがとうございます。
教えていただいたコードをいろいろ試したのですが何度でもメッセージなしで転送出来てしまいます。C5に日付が入っているとしてと言うのは入力シートでいいのでしょうか？入力シートのC5は日付なのですが集計シートの日付はB6から下になるのですが。申し訳ありません教えていただけないでしょうか