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

我已经通过其他职位看了这个，并尝试调整使用Set ActiveWorkbook和设置活动工作表推荐的策略，我仍然得到相同的错误。 我希望能有另一双眼睛能帮上忙，因为我对VBA还是一个新鲜的东西，而我现在还不是那么舒服。

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

代码在这里：

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

切换这个：

  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