Excel VBA Daten in ein anderes Blatt kopieren

Question

Ich möchte den höchsten Wert in der zweiten Zeile des Blattes '2G' finden und fügen Sie die gesamte Spalte in das Blatt 'Daily2G'. Die erste Zeile des Blattes '2G' enthält Datum und Uhrzeit (24 Stunden).

Der Code vergleicht auch das Datum und kopiert nur die Daten, wenn die Daten unterschiedlich sind.

Der Code funktionierte die letzten zwei Tage einwandfrei, aber heute funktioniert es nicht. Ich kann nicht herausfinden, was das Problem ist. Ich würde es begrüßen, wenn sich jemand den Code ansehen und mir sagen könnte, wo ich falsch liege.

Der Code funktioniert, wenn ich die Werte in einer anderen Zeile vergleiche, aber ich möchte die Werte nur in der zweiten Zeile überprüfen. Auch die Dublettenprüfung funktioniert nicht, es war vor heute.

Sub Daily2G() 
    Dim dailySht As Worksheet 'worksheet storing latest store activity 
    Dim recordSht As Worksheet 'worksheet to store the highest period of each day 
    Dim lColDaily As Integer ' Last column of data in the store activity sheet 
    Dim lCol As Integer ' Last column of data in the record sheet 
    Dim maxCustomerRng As Range ' Cell containing the highest number of customers 
    Dim CheckForDups As Range ' Used to find duplicate dates on the record Sheet 
    Dim maxCustomerCnt As Long ' value of highest customer count 

    Set dailySht = ThisWorkbook.Sheets("2G") 
    Set recordSht = ThisWorkbook.Sheets("Daily 2G") 
    With recordSht 
     lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 
    End With 
    With dailySht 
     lColDaily = .Cells(1, .Columns.Count).End(xlToLeft).Column 
     maxCustomerCnt = Application.Max(.Range(.Cells(2, 1), .Cells(2, lColDaily))) 
     Set maxCustomerRng = .Range(.Cells(2, 1), .Cells(2, lColDaily)).Find(What:=maxCustomerCnt, LookIn:=xlValues) 
     If Not maxCustomerRng Is Nothing Then 
     ' Check the Record Sheet to ensure the data is not already there 
      Set CheckForDups = recordSht.Range(recordSht.Cells(1, 1), recordSht.Cells(1, lCol)).Find(What:=maxCustomerRng.Offset(-1, 0).Value, LookIn:=xlValues) 
     ' If CheckForDups is Nothing then the date was not found on the record sheet. Therefore, copy the column 
      If CheckForDups Is Nothing Then 
       maxCustomerRng.EntireColumn.Copy 
       recordSht.Cells(1, lCol + 1).PasteSpecial xlPasteValues 
       recordSht.Cells(1, lCol + 1).PasteSpecial xlPasteFormats 
      End If 
     End If 
    End With 

    Set maxCustomerRng = Nothing 
    Set dailySht = Nothing 
    Set recordSht = Nothing 
End Sub 

Answer 1

Nicht sicher, wie und was versuchen Sie zu finden, als Duplikat so etwas im Code geändert, so dass, wenn gemäß der Beispieldatei 3.488,95 nicht in row2 in Daily2G Blatt gefunden wird, wird der Code Kopieren Sie die Spalte mit Max-Wert in das Daily2G-Blatt, andernfalls wird sie übersprungen.

Auch in der Beispieldatei ist der Name des Arbeitsblattes "Daily2G" nicht "Daily 2G", also wurde es im Code geändert und Sie ändern es in Ihrer tatsächlichen Arbeitsmappe wie erforderlich.

Das Problem mit Ihrem Code ist, dass Sie maxCustomerCnt so lange deklariert haben, während die Werte in Zeile2 auf 2G Blatt Dezimalwerte sind, so dass der NaxCustomerRng immer nichts ist.

Bitte geben diesem einen Versuch ...

Sub Daily2G() 
    Dim dailySht As Worksheet 'worksheet storing latest store activity 
    Dim recordSht As Worksheet 'worksheet to store the highest period of each day 
    Dim lColDaily As Integer ' Last column of data in the store activity sheet 
    Dim lCol As Integer ' Last column of data in the record sheet 
    Dim maxCustomerRng As Range ' Cell containing the highest number of customers 
    Dim CheckForDups As Range ' Used to find duplicate dates on the record Sheet 
    Dim maxCustomerCnt As Double ' value of highest customer count 

    Set dailySht = ThisWorkbook.Sheets("2G") 
    Set recordSht = ThisWorkbook.Sheets("Daily2G") 
    With recordSht 
     lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 
    End With 
    With dailySht 
     lColDaily = .Cells(1, .Columns.Count).End(xlToLeft).Column 
     maxCustomerCnt = Round(Application.Max(.Range(.Cells(2, 1), .Cells(2, lColDaily))), 2) 
     Set maxCustomerRng = .Range(.Cells(2, 1), .Cells(2, lColDaily)).Find(What:=maxCustomerCnt, LookIn:=xlValues) 
     If Not maxCustomerRng Is Nothing Then 
     ' Check the Record Sheet to ensure the data is not already there 
      Set CheckForDups = recordSht.Range(recordSht.Cells(2, 1), recordSht.Cells(2, lCol)).Find(What:=Round(maxCustomerRng.Value, 2), LookIn:=xlValues) 
     ' If CheckForDups is Nothing then the date was not found on the record sheet. Therefore, copy the column 
      If CheckForDups Is Nothing Then 
       maxCustomerRng.EntireColumn.Copy 
       recordSht.Cells(1, lCol + 1).PasteSpecial xlPasteValues 
       recordSht.Cells(1, lCol + 1).PasteSpecial xlPasteFormats 
      End If 
     End If 
    End With 

    Set maxCustomerRng = Nothing 
    Set dailySht = Nothing 
    Set recordSht = Nothing 
End Sub 

Führen Sie den obigen Code in der Beispieldatei, die Sie zur Verfügung gestellt, und wenn es nach der Herstellung erforderlichen Änderungen gut, testen Sie es mit Ihrem tatsächlichen Datei funktioniert.