vba - Excel VBA 将数据复制到不同的工作表中

Question

我想找到“2G”工作表第二行中的最高值，并将其整个列粘贴到“Daily2G”工作表中。 “2G”表的第一行包含日期和时间(24 小时周期)。

代码还会比较日期，并且仅在日期不同时才复制数据。

该代码在过去两天工作正常，但今天无法工作。我不知道问题出在哪里。如果有人可以查看代码并告诉我哪里出错了，我将不胜感激。

如果我比较任何其他行中的值，但我只想检查第二行中的值，则该代码有效。另外，重复检查也不起作用，是在今天之前。

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

不确定您要如何查找重复的内容以及要查找的内容，因此在代码中进行了一些更改，以便如果根据示例文件，在 Daily2G 工作表的第 2 行中找不到 3488.95，则代码将复制该列Daily2G 表的最大值，否则它将跳过。

此外，在示例文件中，工作表名称是“Daily2G”而不是“Daily 2G”，因此请在代码中更改它，然后根据需要在实际工作簿中更改它。

您的代码的问题是您已将 maxCustomerCnt 声明为 long，而 2G 工作表上的 row2 中的值是十进制值，因此 NaxCustomerRng 将始终为空。

请尝试一下...

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

在您提供的示例文件中运行上述代码，如果运行良好，请在进行所需的更改后使用实际文件进行测试。