1

こんにちは、すべての初心者が再び戻ってきました。あるワークシートから非表示の別のワークシートにデータをコピーして貼り付けていますが、既に貼り付けられているものと照合しないとデータが重複する危険性があります。これまでのところ、コピー先のワークシートにコードを挿入して複製を停止しましたが、現在複雑なのは、検証が列全体のデータのすべてのビットを最初から最後までチェックしていることです。これは約 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
4

1 に答える 1

0

非常に長い計算時間の解決策は、シートに既に存在するデータと等しくないデータのみを含む配列を作成することです (コピーされた各要素を繰り返し、非表示のシートの各要素と比較する必要があります)。

それ以外の場合は、複製されたデータを何らかの方法でフォーマットしてから、最初のデータを除くすべてのフォーマットされたデータを繰り返して削除することができます (以前のように再フォーマットします)。例:

Selection.NumberFormat = "0.0 ""double"""  '<--- this could be made also with colors
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
ExecuteExcel4Macro "(2,1,""0.0 ""double"""")"
Selection.FormatConditions(1).StopIfTrue = False

次に、反復内

cells(x,y).select

if counted_formatted_data = 1 then
    Selection.NumberFormat = "0.0 " '<--- back to the previous formatting
else
    selection.delete
end if

もちろん、何も選択せずにこれを行う方がよいでしょう。

于 2013-06-12T08:43:39.130 に答える