Question

我已经浏览了其他帖子，并尝试使用Set ActiveWorkbook和Set Active Worksheet修改了推荐的策略，但我仍然得到相同的错误。我希望另一组眼睛可以提供帮助，因为我对VBA仍然很陌生，而且我对它还不是很满意。

基本上，只要F的单元格与J的单元格不匹配，就可以将单元格从列f复制到列j作为值。我得到E列的行数并将其用作我的计数。 for loop。

代码在这里：

Private Sub CalculateRewards_Click()
    CopyPaste
End Sub

Sub CopyPaste()
    Dim n As Integer
    Dim i As Integer


     n = Sheets("Calculate").Range("E:E").Cells.SpecialCells(xlCellTypeConstants).Count
     i = n

     For Counter = 1 To n

         Set curCell = Sheets("Calculate").Range("F2:F" &i)
         If "$F" &i <> "$J" &i Then
             Sheets("Calculate").Range("$F:$F" &i).Copy
             Sheets("Calculate").Range("$J:$J" &i).PasteSpecial (xlPasteValues)
             Application.CutCopyMode = False
          End If

          i = i + 1
      Next Counter

End Sub

感谢您的帮助

还编辑：链接到具有前一页，第一张交易表和第二张交易表之后的Excel表：https://www.dropbox.com/s/n2mn0zyrtoscjin/Rewards.xlsm

Answer 1

CHange this：

     Set curCell = Sheets("Calculate").Range("F2:F" &i)
     If "$F" &i <> "$J" &i Then
         Sheets("Calculate").Range("$F:$F" &i).Copy
         Sheets("Calculate").Range("$J:$J" &i).PasteSpecial (xlPasteValues)
         Application.CutCopyMode = False
      End If

对此：

     Set curCell = Sheets("Calculate").Range("F2:F" & i)
      If curCell <> Sheets("Calculate").Range("$J" & i) Then
         Sheets("Calculate").Range("$J:$J" &i).Value = curCell.Value
      End If

我可能需要做更多的琐碎，因为我注意到你正在使用SpecialCells本质上过滤范围，所以迭代For i = 1 to n...可能不起作用。也许是这样的：

    Dim rngCalc as Range
    Set rngCalc = Sheets("Calculate").Range("E:E").Cells.SpecialCells(xlCellTypeConstants)
    For each curCell in rngCalc.Cells
        If curCell <> curCell.Offset(0, 4) Then
            curCell.Offset(0, 4).Value = curCell.Value
        End If
    Next

Answer 2

编辑：此子将计算最后一笔交易的点数（标识为包含交易的最右侧列），并将其写在C列中。

Option Explicit
Sub UpdateCurrentPurchase()

Dim CalcSheet As Worksheet
Dim LastTransRange As Range, TargetRange As Range
Dim LastTransCol As Long, LastTransRow As Long
Dim PurchaseArray() As Variant
Dim Points As Long, Index As Long

'set references up-front
Set CalcSheet = ThisWorkbook.Worksheets("Calculate")
With CalcSheet
    LastTransCol = .Cells(2, .Columns.Count).End(xlToLeft).Column '<~ find the last column
    LastTransRow = .Cells(.Rows.Count, LastTransCol).End(xlUp).Row
    Set LastTransRange = .Range(.Cells(2, LastTransCol), .Cells(LastTransRow, LastTransCol))
    Set TargetRange = .Range(.Cells(2, 6), .Cells(LastTransRow, 6)) '<~ column F is the Current Purchase Col
    LastTransRange.Copy Destination:=TargetRange '<~ copy last transactions to Current Purchase Col
End With

'pull purchases into a variant array
PurchaseArray = TargetRange

'calculate points
For Index = 1 To LastTransRow
    Points = Int(PurchaseArray(Index, 1) / 10) '<~ calculate points
    CalcSheet.Cells(Index + 1, 3) = Points '<~ write out the points amount in col C
Next Index

End Sub

原始回复：我认为以下内容可以帮助您实现目标。话虽这么说，似乎只是用列F覆盖列J（作为值）可能是获得可接受答案的最快方式，所以如果是这样的话，我们可以使用Range更快地重新编写代码对象。

Option Explicit
Private Sub CalculateRewards_Click()
    CopyPaste
End Sub

Sub CopyPaste()

Dim LastRow As Long, Counter As Long
Dim cSheet As Worksheet '<~ add a worksheet reference to save some typing

'set references up front
Set cSheet = ThisWorkbook.Worksheets("Calculate")
With cSheet
    LastRow = .Range("E" & .Rows.Count).End(xlUp).Row '<~ set loop boundary

    'loop that compares the value in column 6 (F) to the value in
    'column 10 (J) and writes the value from F to J if they are not equal
    For Counter = 1 To LastRow
        If .Cells(Counter, 6).Value <> .Cells(Counter, 10).Value Then
            .Cells(Counter, 10) = .Cells(Counter, 6)
        End If
    Next Counter
End With

End Sub

运行时错误1004应用程序定义的错误或对象定义的错误

2 个答案: