Excel 宏覆盖现有数据

当我运行以下代码时，它会将值传递给Sheet2中的指定单元格，但它也会覆盖现有数据并清除其中的任何内容

Dim w1 As Worksheet, w2 As Worksheet
Dim a As Variant, o As Variant
Dim w1 As Worksheet, w2 As Worksheet
Dim a As Variant, o As Variant
Dim i As Long, j As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
a = w1.Range("A1:H" & w1.Range("A" & Rows.Count).End(xlUp).Row)

ReDim o(1 To UBound(a, 1), 1 To 8)
For i = LBound(a, 1) To UBound(a, 1)
If a(i, 2) <> "Red apple" Then
   j = j + 1
   o(j, 4) = a(i, 3)
   o(j, 6) = a(i, 5)
   o(j, 8) = a(i, 7)


  ElseIf a(i, 2) = "Red apple" And a(i + 1, 2) = "Green apple" Then
    j = j + 1
        o(j, 4) = a(i, 3) + a(i + 1, 3)
        o(j, 6) = a(i, 5) + a(i + 1, 5)
        o(j, 8) = a(i, 7) + a(i + 1, 7)
    i = i + 1
  Else
    j = j + 1
    o(j, 4) = a(i, 3)
    o(j, 6) = a(i, 5)
    o(j, 8) = a(i, 7)
  End If
Next i
With w2
  .Columns(1).ClearContents
  .Range("A1").Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(1).AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

第2张：

yyy yy  yy  88      88      88
yyy yy  yy  88      88      88
yyy yy  yy  134     134     134
yyy yy  yy  34      55      55
yyy yy  yy  33      55      55
yyy yy  yy  123     123     123
yyy yy  yy  55      55      55
yyy yy  yy  5       3       8
yyy yy  yy  110     110     110
yyy yy  yy  34      90      22
yyy yy  yy  12      76      11
yyy yy  yy  55      55      55
yyy yy  yy  55      55      55

---

需要修复的几点：
1.显式更改循环变量的值是一件坏事。如果您觉得有必要这样做（就像在您当前的代码中），请重新考虑逻辑。这里的逻辑是，不管发生什么，都要将值从

a

复制到

o

；只有当行标题显示“Green apples”时，才添加值，而不是复制。现在，条件语句反映了这一点。
2.您的输出仅包含3个有效列（4、6、8），但该数组与源数组一样大。难怪未使用的元素会用。。。没有，因为它们是空的。我已将左上角移动到

D1

，并将目标范围缩短到输出数组所能容纳的范围。输出列现在从4开始。
3.不清楚为什么要清除目标工作表中的第1列并设置其格式，因为您从未对其进行过写入。
4.作为旁白：使用

选项Explicit

和显式变量声明，并在首次使用变量之前为变量赋值（此处：

j

）

---

你想要什么。亲爱的@user1016274谢谢您的帮助。我已经按原样运行了这个程序，但我确实看到了任何反应。这样子不行。如有任何建议，将不胜感激。谢谢。我需要给客人更好的解释。下一步，我就不工作了。我甚至可以判断它是否正在阅读。我已经创建了一个包含两张工作表的新工作表，“Sheet1”和“Sheet2”。我复制了您发布到Sheet1的数据，并运行了sub。数据已按预期复制并添加到Sheet2。运行代码时您看到了什么？有错误信息吗？您可以在VBA编辑器中单步浏览sub，并查看它在每一步中的作用。向用户致歉1016274。你的代码很完美，当我做一些更改时，是我做错了。代码不仅有效，还花了您时间解释，非常感谢。没关系，我很高兴它现在对您有效。如果您对我的答案感到满意，请单击左侧的图标“接受”。

yyy yy  yy  88      88      88
yyy yy  yy  88      88      88
yyy yy  yy  134     134     134
yyy yy  yy  34      55      55
yyy yy  yy  33      55      55
yyy yy  yy  123     123     123
yyy yy  yy  55      55      55
yyy yy  yy  5       3       8
yyy yy  yy  110     110     110
yyy yy  yy  34      90      22
yyy yy  yy  12      76      11
yyy yy  yy  55      55      55
yyy yy  yy  55      55      55

  Option Explicit
  Sub copystuff()
     Dim i As Long, j As Long
     Dim a, o

     ' Application.ScreenUpdating = False
     Set w1 = Sheets("Sheet1")
     Set w2 = Sheets("Sheet2")
     ' copy source values into field a
     a = w1.Range("A1:H" & w1.Range("A" & Rows.Count).End(xlUp).Row)

     ReDim o(1 To UBound(a, 1), 4 To 8)
     j = 1
     For i = LBound(a, 1) To UBound(a, 1)
        If a(i, 2) = "Green apple" Then
           j = j - 1
           o(j, 4) = o(j, 4) + a(i, 3)
           o(j, 6) = o(j, 6) + a(i, 5)
           o(j, 8) = o(j, 8) + a(i, 7)
        Else
           o(j, 4) = a(i, 3)
           o(j, 6) = a(i, 5)
           o(j, 8) = a(i, 7)
        End If
        j = j + 1
     Next i

     With w2
        .Columns(1).ClearContents
        .Range("D1").Resize(UBound(o, 1), UBound(o, 2) - LBound(o, 2) + 1) = o
        .Columns(1).AutoFit
        .Activate
     End With
     Application.ScreenUpdating = True
  End Sub