VBA通过IF声明循环

时间:2013-12-11 18:40:18

标签: vba loops if-statement

VBA编程的新手,但需要它来完成一个项目。

我基本上是在尝试根据IF语句复制和粘贴单元格,并希望在逐个单元格的基础上执行此操作,因此我合并了一个循环。代码如下所示。最终发生的事情是复制/粘贴第一行就好了,但循环不会继续。当我使用debug.print i时,填充的唯一数字是6。我也尝试了一个For声明,但最终表现方式相同。有什么想法吗?

Private sub Copy_Dates()
Dim i as Integer
i =6 

Do 
   If Cells(i,79)= 1 then 
       Sheets("Tracking").Select
       Range(Cells(i,106),Cells(i,108)).Copy

       Sheets("Tr_Tracking").Select
       Range(Cells(i_25003,2),cells(i+25003,4)).PasteSpecial Paste:=xlPasteValues
   End if 
i= i+1
Loop while i < 10

End sub

编辑: 所以我意识到我想要的代码对我的项目不再有用了。我真正需要的是一种根据标准选择非连续单元格的方法,然后将这些单元格作为单个块复制到另一个工作表。

因此,从上面的代码中,我需要确保选择

.range(.cells(i,106,.cells(i,108))

仅在满足以下条件时:

if .cells(i,79)=1

然后想象我会根据这个条件得到一些选定的单元格,然后我就可以将它粘贴到上面定义的第二个工作表wsO=thisworkbook.sheets("TR_Tracking")

我希望这是有道理的,希望不要太复杂的逻辑。

编辑:编辑: 我能够弄清楚这个。我使用下面的代码来完成上面的编辑部分。

Private Sub SelectArray_andCopy()
Dim FinalSelection as Range
Sheets("Tracking").Select
Cells(2,79).Select
For each c in intersect(activesheet.usedrange,range("CA6:CA500"))
    if c.value=1 then 
        if finalselection is nothing then   
            set finalselection=range(cells(c.row,106),cells(c.row,108))
        else
            set finalselection = union(finalselection, range(cells(c.row,106,cells(c.row,108)))
        end if 
    end if 
next c 
if not finalselection is nothing then finalselection.select

Selection.copy
Sheets("TR_Tracking").Select
Range("b250009,d26000").PasteSpecial Paste:=xlPasteValues

1 个答案:

答案 0 :(得分:2)

问题是你正在使用.Select因此焦点正在改变。您的单元格对象也不完全合格。

INTERESTING READ

进一步i_25003不正确。我想你的意思是i + 25003

试试这个( UNTESTED

Private Sub Copy_Dates()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim i As Long

    Set wsI = ThisWorkbook.Sheets("Tracking")
    Set wsO = ThisWorkbook.Sheets("Tr_Tracking")

    For i = 6 To 9
        With wsI
            If .Cells(i, 79) = 1 Then
               wsO.Range(wsO.Cells(i + 25003, 2), wsO.Cells(i + 25003, 4)).Value = _
               .Range(.Cells(i, 106), .Cells(i, 108)).Value
            End If
        End With
    Next i
End Sub