时间戳

首页 > 解决方案 > 如何在一行中用数组编写以下代码行？

arrays - 如何在一行中用数组编写以下代码行？

问题描述

我想尝试将 Range(K-AT) 和 PasteRange(1-6) 编写为两行代码，以缩短我的代码。我怎样才能用数组做到这一点？

Set RangeK = .Range("K2", "K" & LastRow)
Set RangeD = .Range("D2", "D" & LastRow)
Set RangeW = .Range("W2", "W" & LastRow)
Set RangeX = .Range("X2", "X" & LastRow)
Set RangeZ = .Range("Z2", "Z" & LastRow)
Set RangeAT = .Range("AT2", "AT" & LastRow)

Set PasteRange1 = .Range("A3", "A" & LastRow)
Set PasteRange2 = .Range("B3", "B" & LastRow)
Set PasteRange3 = .Range("C3", "C" & LastRow)
Set PasteRange4 = .Range("D3", "D" & LastRow)
Set PasteRange5 = .Range("E3", "E" & LastRow)
Set PasteRange6 = .Range("F3", "F" & LastRow)

RangeK.Copy
PasteRange1.PasteSpecial xlPasteValues

RangeD.Copy
PasteRange2.PasteSpecial xlPasteValues

RangeW.Copy
PasteRange3.PasteSpecial xlPasteValues

RangeX.Copy
PasteRange4.PasteSpecial xlPasteValues

RangeZ.Copy
PasteRange5.PasteSpecial xlPasteValues

RangeAT.Copy
PasteRange6.PasteSpecial xlPasteValues

标签： arraysexcelvba

解决方案

您不需要复制值

Option Explicit

Private Const startRowSource As Long = 2
Private Const startRowTarget As Long = 3

Sub copyRanges()


Dim wsSource As Worksheet, wsTarget As Worksheet
Dim LastRow As Long

'set wsSource and wsTarget and lastRow here
'....


Dim arrRanges(5, 1) As Range    'mapping via two-dimensional array: first = source, second = target

With ws
    Set arrRanges(0, 0) = "K": Set arrRanges(0, 1) = "A"

    '... add missing mappings
    
    Set arrRanges(5, 0) = "AT": Set arrRanges(5, 1) = "F"
End With

Dim i As Long, rgSource As Range, rgTarget As Range

For i = 0 To UBound(arrRanges, 1)
    Set rgSource = wsSource.Range(arrRanges(i, 0) & startRowSource, arrRanges(i, 0) & LastRow)
    Set rgTarget = wsTarget.Range(arrRanges(i, 1) & startRowTarget, arrRanges(i, 1) & LastRow)
    rgSource.Value = rgTarget.Value
Next

End Sub
``

推荐阅读