0

以下のコードは、シート 1 の「Apple」列の値をシート 2 の「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
4

2 に答える 2

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
于 2013-09-11T21:54:23.970 に答える
1 
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
于 2013-09-11T23:37:02.463 に答える