Question

下面的代码用于将sheet1中“Apple”列下的值复制到sheet2中的“AppleNew”列。（感谢蒂姆）

但是，如果我有多个列（橙色，香蕉等），有没有办法编写更简单的代码，而不必复制和粘贴每列的代码？

Dim rng as range, rngCopy as range, rng2 as range

set rng = Sheet1.Rows(3).Find(What:="Apple", LookIn:=xlValues, LookAt:=xlWhole)

if not rng is nothing then

    set rngCopy = Sheet1.range(rng.offset(1,0), _
                               Sheet1.cells(rows.count,rng.column).end(xlUp))

    set rng2 = Sheet2.Rows(1).Find(What:="AppleNew", LookIn:=xlValues, _
                                   LookAt:=xlWhole)

    if not rng2 is nothing then rngCopy.copy rng2.offset(1,0)

end if

Answer 1

Dim varColName As Variant

For Each varColName In Array("Orange", "Banana", "Pear")

    'Your code goes here
    'In your code, replace "Apple" with varColName
    'In your code, replace "AppleNew" with varColName & "New"

Next varColName

Answer 2

sub Tester()

    DoColumnCopy "Apple", "AppleNew"
    DoColumnCopy "Apple2", "Orange"

end sub

sub Tester2()
   dim i, arrFrom, arrTo

   arrFrom = Array("Apple","Apple2") 'source cols
   arrTo=Array("AppleNew","Orange")  'destination cols

   for i=lbound(arrFrom) to ubound(arrFrom)
       DoColumnCopy Cstr(arrFrom(i)), Cstr(arrTo(i)) 'EDIT: pass as strings
   next i
end sub




Sub DoColumnCopy(FromColName as string, ToColName as string)

    Dim rng as range, rngCopy as range, rng2 as range

    set rng = Sheet1.Rows(3).Find(What:=FromColName , LookIn:=xlValues, _
                                  LookAt:=xlWhole)

    if not rng is nothing then

        set rngCopy = Sheet1.range(rng.offset(1,0), _
                        Sheet1.cells(rows.count,rng.column).end(xlUp))

        set rng2 = Sheet2.Rows(1).Find(What:=ToColName , LookIn:=xlValues, _
                                   LookAt:=xlWhole)

        if not rng2 is nothing then rngCopy.copy rng2.offset(1,0)

    end if

end sub

查找，复制和;粘贴多列下的值

2 个答案: