Question

我不知道我哪里出错了。我试图将列中的值（＆＃34; B＆＃34;）与引用的单元格进行比较（＆＃34; A1＆＃34;）。如果列＆＃34; B＆＃34;等于＆＃34; A1＆＃34;我希望它能算数。当它到达Column＆＃34; B＆＃34;我试图让它循环回来并比较列中的值＆＃34; B＆＃34;使用＆＃34; A2＆＃34;等。例如：

到目前为止，我已经写了两个不同的代码，一个是嵌套的do while循环，另一个是if if循环，但我不能让它们遍历整个列

Sub CountDb()
Dim i As Long
Dim iRow As Long
Dim initial As Long

i = 1
iRow = 1
initial = 1

Do While Cells(iRow, "A").Value <> "" 'initial loop, whilst there are values in cell "A" continue the loop 
    Do While Cells(i, "B").Value = Cells(iRow, "A").Value 'nested while loop, comparing the first B1 and cell A1.
        If True Then Cells(i, "C") = initial 'if they A1 and B1 are equal, print 1 in column C
        initial = initial + 1 'and move on comparing A1 with B2
        If False Then
            i = i + 1 'if not satisfied, move on to cell B2 etc. 
    Loop
iRow = iRow + 1 'when you get to the end of column B, start again and compare values with A2 and B
Loop
End Sub

Sub CountDb()
Dim i As Long
Dim iRow As Long
Dim initial As Long
'same comments as above, just different methodology
i = 1
iRow = 1
initial = 1

Do While Cells(iRow, "A").Value <> ""
    If Cells(i, "B").Value = Cells(iRow, "A").Value Then
        Cells(i, "C") = initial
    Else

    initial = initial + 1
    i = i + 1

    End If

    iRow = iRow + 1
Loop
End Sub

任何帮助将不胜感激。谢谢！

*编辑 - 修正了列引用 **编辑 - 对代码应用注释

Answer 1

请改为尝试：

Option Explicit
Sub test()
Dim sht As Worksheet
Dim lastrow As Long, i as integer, j as integer, initial as integer
Set sht = Workbooks("Book1").Worksheets("Sheet1") 'Don't forget to change this
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

For i = 1 To lastrow
    initial = 1
    lastrow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
    For j = 1 To lastrow
        If Workbooks("Book1").Worksheets("Sheet1").Range("A" & i).Value = Workbooks("Book1").Worksheets("Sheet1").Range("B" & j).Value Then
            Workbooks("Book1").Worksheets("Sheet1").Range("C" & j).Value = initial
            initial = initial + 1
        End If
    Next j
Next i
End Sub

我更喜欢使用For循环而不是While s，因为我可以更容易地看到范围循环。这里我们使用嵌套的For循环，第一个循环遍历A列，第二个循环遍历B列。If我们在A列中的值等于B列中的值，我们将初始数字放在C列使用嵌套循环中的变量。

注意如何使这项工作，我们重新初始化我们的lastrow变量来为我们的循环制作范围。

Answer 2

使用countif非常有用。

Sub test()
    Dim rngOrg As Range, rngDB As Range
    Dim Wf As WorksheetFunction
    Dim vR() As Variant
    Dim i As Long, n As Long

    Set Wf = WorksheetFunction

    Set rngOrg = Range("a1", Range("a" & Rows.Count).End(xlUp))
    Set rngDB = Range("b1", Range("b" & Rows.Count).End(xlUp))
    n = rngDB.Rows.Count
    ReDim vR(1 To n, 1 To 1)
    For Each Rng In rngDB
        i = i + 1
        If Wf.CountIf(rngOrg, Rng) Then
            vR(i, 1) = Wf.CountIf(Range("b1", Rng), Rng)
        End If
    Next Rng
    Range("c1").Resize(n) = vR

End Sub

Answer 3

这是另一种方法，这次使用Find。这可能可能比循环方法更快，因为它利用内置的find函数跳到下一个匹配。

为了清晰起见，我已对下面的代码进行了评论，但基本上我们循环了A列中的值（使用For循环，因为它们不太容易出现伪装的无限循环While）并在B列中查找。

注意：这看起来有点长，但这主要是因为（a）我添加了很多评论，（b）我使用了{ {1}}语句以确保范围完全限定。

With

Answer 4

诀窍是使声明透明。之后编程非常简单。

Sub CountMatches()

    Dim Rng As Range                    ' "count" range (= column "B")
    Dim Itm As String                   ' item from the "items' column (= "A")
    Dim Rla As Long, Rlb As Long        ' last row in columns A and B
    Dim Ra As Long, Rb As Long          ' row counters
    Dim Counter As Long                 ' count matches

    With ActiveSheet
        ' look for the last used rows
        Rla = .Cells(.Rows.Count, "A").End(xlUp).Row
        Rlb = .Cells(.Rows.Count, "B").End(xlUp).Row

        ' start looking for matches from row 2
        Set Rng = .Range(.Cells(2, "B"), .Cells(Rlb, "B"))

        ' start looping in row 2
        For Ra = 2 To Rla
            Itm = .Cells(Ra, "A").Value
            If Len(Trim(Itm)) Then      ' skip if blank
                ' start comparing from row 2
                For Rb = 2 To Rlb
                    ' compare not case sensitive
                    If StrComp(.Cells(Rb, "B").Value, Itm, vbTextCompare) = 0 Then
                        Counter = Counter + 1
                    End If
                Next Rb
                .Cells(Ra, "C").Value = Counter
                Counter = 0
            End If
        Next Ra
    End With
End Sub

现在的问题是，为我工作的透明度对您来说是否透明。我希望如此。： - ）

Answer 5

这应该明显加快。

Sub CountMatches_2()

    Dim Rng As Range                    ' "count" range (= column "B")
    Dim Itm As String                   ' item from the "items' column (= "A")
    Dim Rla As Long, Rlb As Long        ' last row in columns A and B
    Dim Ra As Long, Rb As Long          ' row counters

    With ActiveSheet
        ' look for the last used rows
        Rla = .Cells(.Rows.Count, "A").End(xlUp).Row
        Rlb = .Cells(.Rows.Count, "B").End(xlUp).Row

        ' start looking for matches from row 2
        Set Rng = .Range(.Cells(2, "B"), .Cells(Rlb, "B"))

        ' start looping in row 2
        For Ra = 2 To Rla
            Itm = .Cells(Ra, "A").Value
            If Len(Trim(Itm)) Then      ' skip if blank
                .Cells(Ra, "C").Value = Application.CountIf(Rng, Itm)
            End If
        Next Ra
    End With
End Sub

此代码假定A列中的每个项目都是唯一的。如果不是重复，则会创建重复项，但在创建它们之前或之后很容易消除。

VBA嵌套执行循环与嵌套执行而如果循环

5 个答案: