Question

这是我在这里的第一篇文章，我花了一些时间搜索并用新鲜的眼睛盯着墙头看着我，但我还在学习VBA，可能会遗漏一些东西。我正在尝试将值的分组从我输入的列移动到具有我之前的条目历史的表，以便我可以计算平均值。我正在使用IF条件来检测输入字段中的值，但由于某种原因，它会跳到IF循环的末尾并给出ELSE结果。我能做错的事情能脱颖而出吗？

提前致谢

Sub MoveValuesToPrior()
'
' MoveValuesToPrior Macro
'
Application.ScreenUpdating = False

If WorksheetFunction.Sum(Sheets(2).Range("D3:D1000")) > 0 Then

Sheets(1).Range("C2:C11").Copy
Sheets(1).Range("B2").PasteSpecial Paste:=xlPasteValues

Sheets(2).Range("D3:D1000").Copy
Sheets(2).Range("C3").PasteSpecial Paste:=xlPasteValues
Sheets(2).Range("D3:D1000").ClearContents
Sheets(2).Range("L3:L1000").Copy
Sheets(2).Range("K3").PasteSpecial Paste:=xlPasteValues
Sheets(2).Range("L3:L1000").ClearContents

Sheets(3).Range("D3:D1000").Copy
Sheets(3).Range("C3").PasteSpecial Paste:=xlPasteValues
Sheets(3).Range("D3:D1000").ClearContents
Sheets(3).Range("L3:L1000").Copy
Sheets(3).Range("K3").PasteSpecial Paste:=xlPasteValues
Sheets(3).Range("L3:L1000").ClearContents

Sheets(4).Range("D3:D1000").Copy
Sheets(4).Range("C3").PasteSpecial Paste:=xlPasteValues
Sheets(4).Range("D3:D1000").ClearContents
Sheets(4).Range("L3:L1000").Copy
Sheets(4).Range("K3").PasteSpecial Paste:=xlPasteValues
Sheets(4).Range("L3:L1000").ClearContents

Sheets(5).Range("D3:D1000").Copy
Sheets(5).Range("C3").PasteSpecial Paste:=xlPasteValues
Sheets(5).Range("D3:D1000").ClearContents
Sheets(5).Range("L3:L1000").Copy
Sheets(5).Range("K3").PasteSpecial Paste:=xlPasteValues
Sheets(5).Range("L3:L1000").ClearContents

Sheets(6).Range("D3:D1000").Copy
Sheets(6).Range("C3").PasteSpecial Paste:=xlPasteValues
Sheets(6).Range("D3:D1000").ClearContents
Sheets(6).Range("L3:L1000").Copy
Sheets(6).Range("K3").PasteSpecial Paste:=xlPasteValues
Sheets(6).Range("L3:L1000").ClearContents

Sheets(7).Range("D3:D1000").Copy
Sheets(7).Range("C3").PasteSpecial Paste:=xlPasteValues
Sheets(7).Range("D3:D1000").ClearContents
Sheets(7).Range("L3:L1000").Copy
Sheets(7).Range("K3").PasteSpecial Paste:=xlPasteValues
Sheets(7).Range("L3:L1000").ClearContents

Sheets(8).Range("D3:D1000").Copy
Sheets(8).Range("C3").PasteSpecial Paste:=xlPasteValues
Sheets(8).Range("D3:D1000").ClearContents
Sheets(8).Range("L3:L1000").Copy
Sheets(8).Range("K3").PasteSpecial Paste:=xlPasteValues
Sheets(8).Range("L3:L1000").ClearContents

Sheets(9).Range("D3:D1000").Copy
Sheets(9).Range("C3").PasteSpecial Paste:=xlPasteValues
Sheets(9).Range("D3:D1000").ClearContents
Sheets(9).Range("L3:L1000").Copy
Sheets(9).Range("K3").PasteSpecial Paste:=xlPasteValues
Sheets(9).Range("L3:L1000").ClearContents

Sheets(1).Activate

Application.CutCopyMode = False


Else: MsgBox ("The current data has already been moved to prior.")

End If


Application.ScreenUpdating = True

End Sub

Answer 1

循环和子程序使您的代码更易于管理：

Sub MoveValuesToPrior()

    Dim x As Long

    Application.ScreenUpdating = False

    If WorksheetFunction.Sum(Sheets(2).Range("D3:D1000")) > 0 Then

        'False as last argument -> don't clear source range
        CopyValues Sheets(1).Range("C2:C11"), Sheets(1).Range("B2"), False

        For x = 2 To 9
            CopyValues Sheets(x).Range("D3:D1000"), Sheets(x).Range("C3")
            CopyValues Sheets(x).Range("L3:L1000"), Sheets(x).Range("K3")
        Next x
    Else
        MsgBox ("The current data has already been moved to prior.")
    End If

    Sheets(1).Activate
    Application.ScreenUpdating = True

End Sub

Sub CopyValues(rngFrom As Range, rngTo As Range, Optional clearSource As Boolean = True)
    With rngFrom
        rngTo.Resize(.Rows.Count, .Columns.Count).Value = .Value
        If clearSource Then .ClearContents
    End With
End Sub

vba无法识别单元格中的值

1 个答案: