Question

当我运行以下代码时，它会将值传递给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

Sheet 1中：

    A   B           C   D   E   F   G   H
sheet1  orange      89      89      89  
sheet2  Banana      56      56      56  
sheet3  Red apple   154     78      78  
sheet4  Green apple 76      76      76  
sheet5  orange      44      44      44  
sheet6  Banana      33      33      33  
sheet7  Red apple   22      22      32  
sheet8  Green apple 78      78      78  
sheet9  orange      90      56      33  
sheet10 Banana      22      22      22  
sheet11 Red apple   57      35      35  
sheet12 Green apple 90      22      22

Sheet 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

Answer 1

需要修复的几点：
1.明确地改变循环变量的值是一个坏事。如果您觉得有必要这样做（比如现在的代码），请重新考虑逻辑。在这里，逻辑是您将值从a复制到o，无论如何;并且只有当行标题显示为“青苹果”时，您添加值而不是复制。条件现在反映了这一点 2.您的输出只保留3个有效列（4,6,8），但数组与源数组一样大。难怪未使用的元素会覆盖目标工作表范围，因为它们是空的。我已将左上角移动到D1并将目标范围缩短为输出数组所保持的范围。输出列现在从4开始 3.目前还不清楚为什么要清除并格式化目标表中的第1列，因为您从未写过它 4.暂且不说：使用Option Explicit和显式变量声明，并在变量首次使用之前为变量赋值（此处为：j）。

  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

宏会覆盖现有数据

1 个答案: