こんにちは、すべての初心者が再び戻ってきました。あるワークシートから非表示の別のワークシートにデータをコピーして貼り付けていますが、既に貼り付けられているものと照合しないとデータが重複する危険性があります。これまでのところ、コピー先のワークシートにコードを挿入して複製を停止しましたが、現在複雑なのは、検証が列全体のデータのすべてのビットを最初から最後までチェックしていることです。これは約 5000 < エントリ。列 B には、同じ月末に属するすべてのエントリで同じレポート日付があります。したがって、30/1/13....28/02/13 などの 5000 エントリがあるとします。理想的には、レポートの日付が入力されている列 B で 1 回だけ確認し、日付が何と一致するかを確認したいと考えています。コピーしたい、次に、コピー範囲内の個々のエントリを検証する代わりに、コピー貼り付けプロセス全体を拒否します。ここに私が取り組んでいるコードがあります。私が理にかなっているといいのですが、助けてくれてありがとう。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim ans As String
Const myCol As Long = 2
If Intersect(Target, Columns(myCol)) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Intersect(Target, Columns(myCol))
If Application.CountIf(Columns(myCol), r.Value) > 1 Then
MsgBox (r.Value & " already exsists")
r.ClearContents
End If
Next
Application.EnableEvents = True
End Sub
それは重複の削除を含む私のコードですが、機能していません。私はそれを試しました
Sub LoadData_toTable()
Dim ws1LRow As Long, ws2LRow As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Application.ScreenUpdating = False
Set ws1 = ThisWorkbook.Sheets("RAW DATA")
Set ws2 = ThisWorkbook.Sheets("DATA INPUT")
With ws1
ws1LRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row + 1
End With
With ws2
ws2LRow = .Range("G" & .Rows.Count).End(xlUp).Row
.Range("A2:AR" & ws2LRow).Copy
ws1.Range("A" & ws1LRow).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End With
With ws1
ws1.Range("A:A").RemoveDuplicates
End With
For Each WS In ThisWorkbook.Worksheets
For Each PT In WS.PivotTables
PT.RefreshTable
Next PT
Next WS
MsgBox "Loading month's data complete!"
End Sub