遇到难题了，想了好久还是不行

albertbake654

准备自己想出来，但是想了一天也没搞好。求助大家！谢谢！我想统计A列数据的重合情况，当B2大于等于4的时候，A2向下比对三行（A3，A4，A5）如果A2与A3数字相同，则C3单元格写入”重合“，如果A2与A4数字相同，则C4单元格写入”重合“，如果A2与A5数字相同，则C5单元格写入“”重合“”；当B2等于3的时候，A2向下比对两行（A3，A4），如果A2与A3数字相同，则C3单元格写入”重合“，如果A2与A4数字相同，则C4单元格写入”重合“；当B2等于2时，A2向下比较一行（A3）相同的话则在C3写入“”重合‘’，当B2等于1时C2是什么就是什么。依次向下统计A列数据的重合情况。但是还有一个问题，假设C3是’”重合",则统计A3的时候直接跳过，统计A4与A列后面数据的重合情况。想不出来！求解答！谢谢！
Sub 统计重合()
    Dim i%, t%
    i = 2
    Do While Cells(i, "B") <> ""
        Select Case Cells(i, "B")
            Case Is >= 4
                For t = 1 To 3
                If Cells(i, "A") = Cells(i + t, "A") Then
                    Cells(i + t, "C").Value = "重合"
                Else
                    Cells(i + t, "C").Value = ""
                End If
                Next
            Case Is = 3
                For t = 1 To 2
                If Cells(i, "A") = Cells(i + t, "A") Then
                    Cells(i + t, "C").Value = "重合"
                Else
                    Cells(i + t, "C").Value = ""
                End If
                Next
            Case Is = 2
                If Cells(i, "A") = Cells(i + 1, "A") Then
                    Cells(i + 1, "C").Value = "重合"
                Else
                    Cells(i + 1, "C").Value = ""
                End If
           Case Is = 1
           Cells(i, "C").Value = Cells(i, "C")
            End Select

    i = i + 1
    Loop
End Sub

micch

模拟几个结果最好了

东南西北中发财

当B2大于等于4的时候，A2向下比对三行（A3，A4，A5）如果A2与A3数字相同，则C2单元格写入”重合“
——你这句话，以及后面的话，向下比较几行到底有什么意义？
如果A2与A3数字相同。。。。这不全部都是向下比较一行？如果A2与A4相同呢？如果A2与A5相同呢？能不能严谨一点！

albertbake654

东南西北中发财 发表于 2019-12-9 11:41
当B2大于等于4的时候，A2向下比对三行（A3，A4，A5）如果A2与A3数字相同，则C2单元格写入”重合“
—— ...

不好意思，写错了。谢谢您的关注。我想统计A列数据的重合情况，当B2大于等于4的时候，A2向下比对三行（A3，A4，A5）如果A2与A3数字相同，则C3单元格写入”重合“，如果A2与A4数字相同，则C4单元格写入”重合“，如果A2与A5数字相同，则C5单元格写入“”重合“”；当B2等于3的时候，A2向下比对两行（A3，A4），如果A2与A3数字相同，则C3单元格写入”重合“，如果A2与A4数字相同，则C4单元格写入”重合“；当B2等于2时，A2向下比较一行（A3）相同的话则在C3写入“”重合‘’，当B2等于1时C2是什么就是什么。依次向下统计A列数据的重合情况。但是还有一个问题，假设C3是’”重合",则统计A3的时候直接跳过，统计A4与A列后面数据的重合情况。

月关

这个意思？

Sub test()
Dim arr, i&, j&
arr = [a1].CurrentRegion
For i = 2 To UBound(arr)
    If arr(i, 3) = "重合" Then GoTo nxt
    For j = 1 To IIf(arr(i, 2) = 2, 1, IIf(arr(i, 2) = 3, 2, IIf(arr(i, 2) >= 4, 3, 0)))
        If arr(i, 1) = arr(i + j, 1) Then arr(i + j, 3) = "重合"
    Next
nxt:
Next
[a1].CurrentRegion = arr
End Sub

albertbake654

月关 发表于 2019-12-9 15:39
这个意思？

Sub test()

谢谢您的代码，让我提升了很多。太谢谢您了！我想了一整天没法子，高山仰止，继续学习！

月关

albertbake654 发表于 2019-12-9 16:29
谢谢您的代码，让我提升了很多。但是提示下标越界

不会呀，我这边跑的贼溜，发上你出错的文件来看看

大灰狼1976

1. Sub test()
   
2. Dim arr, i&, j&, n&
   
3. [c2:c1000000].ClearContents
   
4. arr = [a1].CurrentRegion
   
5. For i = 2 To UBound(arr) - 1
   
6.   If arr(i, 3) = "" Then
   
7.     n = IIf(arr(i, 2) > 4, 3, arr(i, 2) - 1)
   
8.     For j = i + 1 To i + n
   
9.       If j > UBound(arr) Then Exit For
   
10.       If arr(i, 1) = arr(j, 1) Then arr(j, 3) = "chonghe"
    
11.     Next j
    
12.   End If
    
13. Next i
    
14. [c1].Resize(UBound(arr)) = Application.Index(arr, , 3)
    
15. End Sub

复制代码

albertbake654

月关 发表于 2019-12-9 16:48
不会呀，我这边跑的贼溜，发上你出错的文件来看看

确实一点都没问题，太感谢您了！

朝花夕拾2018

高手，学习中。