时间戳

首页 > 解决方案 > Excel VBA 缩短代码以将值从一个范围复制到另一个范围

excel - Excel VBA 缩短代码以将值从一个范围复制到另一个范围

问题描述

我收到了一个包含以下代码的 Excel 工作簿，我想知道如何缩短它以使其更易于管理。该代码重复地将值从一个命名范围中的某些单元格复制到另一个命名范围中的某些单元格，并复制字体和填充颜色。代码比这更长（遵循相同的模式，命名范围以 1 递增），所以我确信有更好的编写方法。

Private Sub Copy_Jobs()

Worksheets("Sales").Range("Week1")(1).Cells.Value = Worksheets("Tasks").Range("Job1")(1).Cells.Value
Worksheets("Sales").Range("Week1")(2).Cells.Value = Worksheets("Tasks").Range("Job1")(2).Cells.Value
Worksheets("Sales").Range("Week1")(3).Cells.Value = Worksheets("Tasks").Range("Job1")(3).Cells.Value
Worksheets("Sales").Range("Week1")(4).Cells.Value = Worksheets("Tasks").Range("Job1")(5).Cells.Value
Worksheets("Sales").Range("Week1").Font.Color = Worksheets("Tasks").Range("Job1").Font.Color
Worksheets("Sales").Range("Week1").Interior.Color = Worksheets("Tasks").Range("Job1").Interior.Color

Worksheets("Sales").Range("Week2")(1).Cells.Value = Worksheets("Tasks").Range("Job2")(1).Cells.Value
Worksheets("Sales").Range("Week2")(2).Cells.Value = Worksheets("Tasks").Range("Job2")(2).Cells.Value
Worksheets("Sales").Range("Week2")(3).Cells.Value = Worksheets("Tasks").Range("Job2")(3).Cells.Value
Worksheets("Sales").Range("Week2")(4).Cells.Value = Worksheets("Tasks").Range("Job2")(5).Cells.Value
Worksheets("Sales").Range("Week2").Font.Color = Worksheets("Tasks").Range("Job2").Font.Color
Worksheets("Sales").Range("Week2").Interior.Color = Worksheets("Tasks").Range("Job2").Interior.Color

End Sub

标签： excelvba

解决方案

将通用代码拆分为单独的子...

Private Sub Copy_Jobs()
    'either like this...
    CopyAndFormat Worksheets("Sales").Range("Week1"), _
                  Worksheets("Tasks").Range("Job1")

    CopyAndFormat Worksheets("Sales").Range("Week2"), _
                  Worksheets("Tasks").Range("Job2")

    '...or in a loop
    Dim i As Long
    For i = 1 to 5
        CopyAndFormat Worksheets("Sales").Range("Week" & i), _
                      Worksheets("Tasks").Range("Job" & i)
    Next i

End Sub

Sub CopyAndFormat(w as Range, j As Range)
    w(1).Cells.Value = j(1).Cells.Value
    w(2).Cells.Value = j(2).Cells.Value
    w(3).Cells.Value = j(3).Cells.Value
    w(4).Cells.Value = j(5).Cells.Value
    w.Font.Color = j.Font.Color
    w.Interior.Color = j.Interior.Color
End Sub

请注意，只有在范围格式一致的情况下，复制字体和内部颜色才真正起作用。

推荐阅读