Question

我是Excel VBA的新手，有一个简单的问题。一旦了解了如何执行此循环，就可以在其上进行构建。

我想自动进行分类。数据在单个列中重复，即sampleA，sampleA，sampleA，sampleB，sampleB，sampleC，sampleC，sampleC等。我希望我的宏标识何时在样品名称之间更改样品名称。因此，例如，当sampleA之后的下一个单元格变为sampleB时，我希望宏了解是否有变化，并在其旁边写一个短语（这将随后变成一个方程式，其中包含样本各行中的数据但是婴儿的步骤:)）。

总体而言，宏需要感知相同样品名称的列之间的变化，直到获得新名称为止。

我一直在研究解决方案，“直到”循环似乎是最接近我需要的解决方案。另外，为了显示sampleA与sampleB不同，我使用了<>。

Sub DoUntilStringMacro()

Dim sampleA As String

Dim sampleB As String

Dim sampleC As String

Dim classification As String

    Do Until ActiveCell.Value = ""

        If sampleA <> sampleB Then
            classification = "hello"
        ElseIf sampleB <> sampleC Then
            classification = "goodbye"
        ElseIf sampleC <> sampleA Then
            classification = "see you soon"
        End If

        answer = classification
        Cells(classification, "B").Value = answer

    Loop

End Sub

实际结果：单元格上的错误（分类，“ B”）。值=答案这里不对劲。我正在尝试在“ B”列中显示结果。

列中的Excel工作表上的预期结果：

Sample:  Classification
sampleA  --
sampleA  --
sampleA  hello
sampleB  --
sampleB  goodbye
sampleC  --
sampleC  --
sampleC  see you soon

Answer 1

您声明了sampleA,B,C变量，但从未设置它们，因此在比较这三个变量时什么也没发生。
在循环中，您永远不会将ActiveCell设置为任何值，因此ActiveCell保持不变。因此，您将永远循环。

这是没有真正优化的重写。当然，有更好的方法可以做到这一点（例如，在Range("A1:A" & lastFilledRow)上使用for循环），但是我想让它与您的尝试非常接近，以便尝试解决计划中的问题，因为它肯定可行合理的方式做到这一点。

我添加了大量评论来解释发生了什么事。

Sub DoUntilStringMacro()

    Dim currentValue As String
    Dim previousValue As String
    Dim classification As String

    'set the first cell to search and we will iterate
    '   from there
    Dim searchCell As Range
    Set searchCell = Sheet1.Range("A2")

    'Lets also get a counter variable to see how many
    '   times we've found a change...
    Dim changesFound As Integer

    'Loop until the searchCell is empty
    Do Until searchCell.Value = ""


        'set the currentValue
        currentValue = searchCell.Value

        'If the previousValue variable is empty then
        '   this is the first cell we're analyzing
        '   so don't bother running this bit of code
        '   that does the comparison
        If previousValue <> "" Then

            'Compare to what we stored in previousValue
            If currentValue <> previousValue Then
                'We found a change, increment our counter
                changesFound = changesFound + 1

                'and based on that value lets figure out
                '   what to write out
                Select Case changesFound
                    Case 1
                        'This is the first time we hit a
                        '   a change so write out "hello"
                        'BUT!!! we need to write it the
                        '   cell above the current
                        '   searchCell and one column over
                        '   We'll use .Offset() to do that
                        searchCell.Offset(-1, 1).Value = "Hello"
                    Case 2
                        searchCell.Offset(-1, 1).Value = "goodbye"
                    Case 3
                        searchCell.Offset(-1, 1).Value = "see you soon"
                End Select

            End If
        End If

        'So we are going to iterate again, lets capture
        '   the currentValue into the previousValue
        '   variable so we have it to compare on the
        '   the next loop
        previousValue = currentValue

        'Also... we want to make sure that searchCell
        '   is the next cell otherwise we will just
        '   keep testing the same cell over and over
        '   again until excel crashes.
        'Again we'll use `.Offset()` to move to the
        '   next row
        Set searchCell = searchCell.Offset(1)

    Loop

    'Heres the kicker... we needed one more iteration
    '   since we exited when the searchCell was blank... 
    '   so that Case 3 never hit... 
    '   we'll just go ahead and fill that out now
    searchCell.Offset(-1, 1).Value = "See you soon"

End Sub

我已经放弃了ActiveCell，因为这不是一个好主意。 Select，Activate，ActiveCell都是VBA中的废话。最好说“我要的是这个单元格/范围”，而不是希望您想要的单元格当前处于活动状态。

Answer 2

您可以尝试For循环：

Option Explicit

Sub Change()

    Dim Lastrow As Long, Row As Long
    Dim PreviousString As String, CurrenctString As String

    'With statement refers to shee 1
    With ThisWorkbook.Worksheets("Sheet1")
        'Find last row in Sheet 1 - Column A
         Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        'Loop each row start from 3 to lastrow
        For Row = 3 To Lastrow
            PreviousString = .Range("A" & Row - 1).Value
            CurrenctString = .Range("A" & Row).Value

            'Check if both strings are not the same
            If PreviousString <> CurrenctString Then
                If PreviousString = "sampleA" And CurrenctString = "sampleB" Then
                    .Range("B" & Row - 1).Value = "hello"
                ElseIf PreviousString = "sampleB" And CurrenctString = "sampleC" Then
                    .Range("B" & Row - 1).Value = "goodbye"
                ElseIf PreviousString = "sampleC" And CurrenctString = "sampleD" Then
                    .Range("B" & Row - 1).Value = "see you soon"
                End If

            End If

        Next Row

    End With


End Sub

Answer 3

您可以使用公式并避免循环：

Sub IdentifySampleNameChanges()
    With Worksheets("Sheet1") ‘ change “Sheet1” to your actual sheet name
          With .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).Offset(, 1)
             .Formula = "=IF(A2<>A3,""Hello"","""")"
             .Value = .Value
        End With 
    End With 
End Sub

在VBA中简单地执行“直到循环”

3 个答案: