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 Sheet的row2中找不到3488.95，代码将复制列Daily2G表的最大值，否则它将跳过。

此外，在示例文件中，工作表名称为“Daily2G”而不是“Daily 2G”，因此在代码中对其进行了更改，并根据需要在实际工作簿中进行更改。

你的代码的问题是你已经声明了maxCustomerCnt的长度，而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

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

Excel VBA将数据复制到另一个工作表

1 个答案: