脚本上的复制和粘贴功能出错

debugcn 发表于 Dev

aab

我的脚本查找最高值dailySht并将这些值粘贴到单独的工作表中recordSht，这通常工作正常，但有时我会收到错误Object variable or With block variable not set。下面是返回错误的代码部分。

Sub DailyBH()
    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 maxCustomerRng2 As Range ' Cell containing the highest number of customers
    Dim maxCustomerCnt As Double ' value of highest customer count

    Set dailySht = ThisWorkbook.Sheets("hourly KPI")
    Set recordSht = ThisWorkbook.Sheets("@BH KPI")
    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(58, 1), .Cells(58, lColDaily))), 2)
        Set maxCustomerRng2 = .Range(.Cells(58, 1), .Cells(58, lColDaily)).Find(What:=maxCustomerCnt, LookIn:=xlValues)

        .Cells(4, maxCustomerRng2.Column).Copy
        recordSht.Cells(4, lCol + 1).PasteSpecial xlPasteValues
        recordSht.Cells(4, lCol + 1).PasteSpecial xlPasteFormats

        .Cells(22, maxCustomerRng2.Column).Copy
        recordSht.Cells(22, lCol + 1).PasteSpecial xlPasteValues
        recordSht.Cells(22, lCol + 1).PasteSpecial xlPasteFormats

        .Cells(40, maxCustomerRng2.Column).Copy
        recordSht.Cells(40, lCol + 1).PasteSpecial xlPasteValues
        recordSht.Cells(40, lCol + 1).PasteSpecial xlPasteFormats

        .Cells(49, maxCustomerRng2.Column).Copy
        recordSht.Cells(49, lCol + 1).PasteSpecial xlPasteValues
        recordSht.Cells(49, lCol + 1).PasteSpecial xlPasteFormats

        .Cells(58, maxCustomerRng2.Column).Copy
        recordSht.Cells(58, lCol + 1).PasteSpecial xlPasteValues
        recordSht.Cells(58, lCol + 1).PasteSpecial xlPasteFormats
    End With

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

有人可以帮我找出问题所在，因为代码在某些单元格而不是其他单元格上工作（复制并粘贴正确的值）。

Pᴇʜ

我建议使用Match而不是直接Find使用结果Max而不将其转换为，Double以避免浮点不准确。

With dailySht
    lColDaily = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Dim SearchRange As Range
    Set SearchRange = .Range(.Cells(58, 1), .Cells(58, lColDaily))

    Dim MaxCol As Long
    On Error Resume Next 'next line throws error if nothing matched
    MaxCol = Application.WorksheetFunction.Match(Application.WorksheetFunction.Max(SearchRange), SearchRange, 0)
    On Error GoTo 0 're-enable error reporting !!!

    If MaxCol = 0 Then
        'nothing was found
        Exit Sub
    End If

    .Cells(4, MaxCol).Copy
    'your stuff here

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。