在VBA中循环并找到相似的数字

Question

我对VBA很新。刚开始阅读它2天前。我想知道如何编写分配给按钮的VB代码来读取整个列并搜索相似的数字。

在确定相似的数字之后，需要转到另一列以检查列中的字符是否也相同。

如果两个逻辑=真。如何更改另一列的值的单元格？

Sample data

对于当前的例子。代码应该知道第一列有匹配的数字。之后，它将检查示例中名称为“a”的名称。之后，它会自动将点数更改为1和0.如果有3个相同的点，则点数为1.0,0

Answer 1

您可以先尝试录制您想要对录制宏执行的任何操作，然后过滤掉不必要的代码。如果您不知道如何使用宏进行录制，请单击下面的链接。您可以从录制的宏中学习，并根据您可能获得的经验，在将来慢慢改进您的代码。

这是[链接]（http://www.dummies.com/software/microsoft-office/excel/how-to-record-a-macro-in-excel-2016/）

Answer 2

根据图片中附加的图片，我假设数字在Column A，用于检查字符的列是Column J，结果需要显示在Column O中，然后尝试使用代码。

Sub Demo()
    Dim dict1 As Object
    Dim ws As Worksheet
    Dim cel As Range, fCell As Range
    Dim lastRow As Long, temp As Long
    Dim c1

    Set dict1 = CreateObject("Scripting.Dictionary")
    Set ws = ThisWorkbook.Sheets("Sheet2")      'change Sheet2 to your data sheet

    With ws
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row    'last row with data in Column A

        c1 = .Range("A2:A" & lastRow)
        For i = UBound(c1, 1) To 1 Step -1          'enter unique values with corresponding values in dict1
            dict1(c1(i, 1)) = .Range("J" & i + 1)   '+1 for Row 2
        Next i

        Set fCell = .Range("A2")
        For Each cel In .Range("A2:A" & lastRow)    'loop through each cell in Column A
            temp = WorksheetFunction.CountIf(.Range(fCell, cel.Address), cel)   'get count
            If temp > 1 Then
                If cel.Offset(0, 9) = dict1(cel.Value) Then
                    cel.Offset(0, 14).Value = 0
                Else
                    cel.Offset(0, 14).Value = 1
                End If
            Else
                cel.Offset(0, 14).Value = 1
            End If
        Next cel
    End With
End Sub

修改

Sub Demo()
    Dim ws As Worksheet
    Dim lastRow As Long
    Application.ScreenUpdating = False

    Set ws = ThisWorkbook.Sheets("Sheet2")  'change Sheet3 to your data range

    With ws
        lastRow = .Cells(.Rows.count, "A").End(xlUp).Row   'last row with data in Column A

        .Range("O2").Formula = "=IF(MOD(SUMPRODUCT(($A$2:$A2=A2)*($J$2:$J2=J2)),3)=1,1,0)"   'enter formula in Cell O2
        .Range("O2").AutoFill Destination:=.Range("O2:O" & lastRow)                'drag formula down
        .Range("O2:O" & lastRow).Value = .Range("O2:O" & lastRow).Value           'keep only values
    End With
    Application.ScreenUpdating = True
End Sub