有效的循环检查VBA

时间:2012-09-24 20:04:09

标签: vba excel-vba excel-2007 excel

摘要:我的公司有两个不同的电子表格,每个电子表格都有很多政策。他们希望我通过政策ID匹配政策,并将旧电子表格中的所有旧笔记转移到新电子表格。

推理:我的问题不在于不了解如何做到这一点,而是最好的方法。自从加入StackOverflow以来,我已经被告知了我应该而且不应该做的事情。我被告知不同的时候最好使用For Each循环而不是简单的Do循环。另外,我被告知我不应该大量使用.Select(但我这样做)。

我将如何正常行事:我通常只会使用Do循环并通过.Find选择数据并使用{{1}来查看数据当我想与当前行中的其他列进行交互时,我只会使用ActiveCell。我倾向于喜欢ActiveCell.Offset()并且一直使用它,但是在这个项目中,我试图将自己从开箱即用中解决,并且可能会改变一些糟糕的编码习惯,并开始使用可能更好的方法。

问题:当我使用.Select循环时,如何进行ActiveCell.Offset()的等效操作?

我的代码: **欢迎提出问题/批评

For Each

实施例

Example Picture for reference's sake

表格的底部

Bottom of the Sheet.

2 个答案:

答案 0 :(得分:2)

首先,你的问题:

Question: How would I go about doing the equivalent of an ActiveCell.Offset() when I'm using a For Each loop?

根据您发布的代码,没有多大意义。这是一个非常普遍的问题,需要一些背景来更好地理解。这真的取决于你的循环。如果您从ActiveCell循环连续的单元格范围,那么您可以说......

For each cel in Range
    myValue = ActiveCell.Offset(,i)
    i = i + 1
Next

获取循环中每个单元格旁边的列。但总的来说,我不会称之为伟大的编程。就像我说的,背景很重要。

就你的代码而言,看看这是否有意义。我已经编辑并评论过你的帮助。哦,是的,干得好Select

Sub transferNotes() '-> first no need for a function, because you are not returning anything...
                       'and no need to use a sub to call a sub here as you don't pass variables,
                       'and you don't have a process you are trying to run

    Dim theColumn As Range, cell As Range '-> just a little cleaner, INMHO
    Dim fromSheet As Worksheet, toSheet As Worksheet '-> just a little cleaner, INMHO
    Dim lastRow As Integer

    Set fromSheet = Sheets("NotesFrom")
    Set toSheet = Sheets("NotesTo")

    With fromSheet ' -> put everything you do in the "fromSheet" in your With block

        lastRow = .Range("B" & .Rows.Count).End(xlUp).Row 'FINDING LAST ROW
        Set theColumn = .Range("B5:B" & lastRow)

        theColumn.AutoFilter 1, "<>"

        Set theColumn = theColumn.SpecialCells(xlCellTypeVisible) '-> now you are only looping through the cells are that are not blank, so it's more efficient

        For Each cell In theColumn

            '-> use of ActiveCell.Offset(), it's not ActiveCell.Offset(), but it uses Offset
            Dim myValue
            myValue = cell.Offset(, 1) '-> gets the cell value in the column to the right of the code


            'WANT TO FIND DATA ON THE toSheet
            toSheet.Cells.Find(What:=cell.Text, After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Activate

        Next cell

    End With

End Sub

答案 1 :(得分:1)

这是我的建议到目前为止。

Function transferNotes()

    Dim SourceColumn As Range
    Dim fromSheet As Worksheet
    Dim toSheet As Worksheet
    Dim cell As Range
    Dim lastRow As Long '<--changed to Long

    Set fromSheet = Sheets("NotesFrom")
    Set toSheet = Sheets("NotesTo")

    With fromSheet                      'FINDING LAST ROW
        lastRow = .Range("B" & .Rows.Count).End(xlUp).Row
    End With

    Set SourceColumn = fromSheet.Range("B5:B" & lastRow)

    For Each cell In SourceColumn          'CODE FOR EACH CELL IN COLUMN
        If cell.Value = "" Then 'the .Text property can
                                'make for some confusing errors.
                                'Try to avoid it.
            'nothng to search for
        Else
            With toSheet         'WANT TO FIND DATA ON THE toSheet
                Dim destRng As Range

                Set destRng = .Range("A:A").Find(What:=cell.Value)
                If Not destRng Is Nothing Then
                    .Cells(destRng.Row, <your mapped column destination>)
                        = fromSheet.Cells(cell.Row,<your mapped column source>)
    ' you can either repeat the above line for all of your non-contiguous
    'sections of data you want to move from sheet to sheet
    '(i.e. if the two sheets are not arranged the same)
    'if the two sheets are aranged the same then change
    'the .cells call to call a range and include
    'the full width of columns
                Else
                    'nothing was found
                End If

            End With
        End If
    Next cell

End Function