[已解决]在Y列提取上一行出现重复的数据，若多个数据用、号隔开，没有重复则显示为空

ruhong18

在Y列提取上一行出现重复的数据，若多个数据用、号隔开

最佳答案

月排行榜 / 总排行榜

心正意诚身修

2021-10-16 12:55

风林火山 发表于 2021-10-16 11:58

1. Sub 重复值()
   
2. Dim ARR, BRR(), irow As Long, IR As Integer, CL As Integer, L As Integer
   
3. irow = Range("C65535").End(xlUp).Row
   
4. ARR = Range("C2:I" & irow)
   
5. ReDim BRR(1 To irow)
   
6. For IR = 2 To irow - 1
   
7.     For CL = 1 To 7
   
8.         If Application.CountIf(Range("C" & IR - 1 & ":I" & IR - 1), ARR(IR - 1, CL)) > 0 Then
   
9.             L = L + 1
   
10.                 If BRR(IR - 1) = "" Then
    
11.                      BRR(IR - 1) = ARR(IR - 1, CL)
    
12.                      Else
    
13.                      BRR(IR - 1) = BRR(IR - 1) & "、" & ARR(IR - 1, CL)
    
14.                End If
    
15.         End If
    
16.     Next
    
17.     L = 0
    
18. Next
    
19. Range("Y2").Resize(irow) = Application.Transpose(BRR)
    
20. End Sub

复制代码

受风林火山老师启发。

跳转到最佳答案楼层

风林火山

1. Sub 查找重复值()
   
2.     Dim k As Long
   
3.     For k = 2 To UBound(arr)
   
4.         Call test(k)
   
5.     Next k
   
6. End Sub
   
7. Sub test(irow As Long)
   
8.     Dim k As Byte, i As Byte
   
9.     For k = 3 To 9
   
10.         For i = 3 To 9
    
11.         If Cells(irow, k) = Cells(irow + 1, i) Then
    
12.             If Cells(irow, 25) = "" Then
    
13.                 Cells(irow, 25).Value = Cells(irow, k).Value
    
14.             Else
    
15.                 Cells(irow, 25).Value = Cells(irow, 25).Value & "、" & Cells(irow, k).Value
    
16.             End If
    
17.         End If
    
18.         Next i
    
19.     Next k
    
20. End Sub
    

复制代码

心正意诚身修

风林火山 发表于 2021-10-16 11:58

下载学习，然后发现你有个理解有误。只要同上一行比较，找看看有没有重复的，你的效果是同时和上一行与下一行一起比较 。

心正意诚身修

风林火山 发表于 2021-10-16 11:58

1. Sub 重复值()
   
2. Dim ARR, BRR(), irow As Long, IR As Integer, CL As Integer, L As Integer
   
3. irow = Range("C65535").End(xlUp).Row
   
4. ARR = Range("C2:I" & irow)
   
5. ReDim BRR(1 To irow)
   
6. For IR = 2 To irow - 1
   
7.     For CL = 1 To 7
   
8.         If Application.CountIf(Range("C" & IR - 1 & ":I" & IR - 1), ARR(IR - 1, CL)) > 0 Then
   
9.             L = L + 1
   
10.                 If BRR(IR - 1) = "" Then
    
11.                      BRR(IR - 1) = ARR(IR - 1, CL)
    
12.                      Else
    
13.                      BRR(IR - 1) = BRR(IR - 1) & "、" & ARR(IR - 1, CL)
    
14.                End If
    
15.         End If
    
16.     Next
    
17.     L = 0
    
18. Next
    
19. Range("Y2").Resize(irow) = Application.Transpose(BRR)
    
20. End Sub

复制代码

受风林火山老师启发。

风林火山

心正意诚身修 发表于 2021-10-16 12:45
下载学习，然后发现你有个理解有误。只要同上一行比较，找看看有没有重复的，你的效果是同时和上一行与下 ...

是下一行和上一行比较，把重复值标到上一行相应的位置

风林火山

心正意诚身修 发表于 2021-10-16 12:55
受风林火山老师启发。

想了好久，不知道咋用数组，学习了，老师厉害。

心正意诚身修

风林火山 发表于 2021-10-16 13:05
想了好久，不知道咋用数组，学习了，老师厉害。

哈哈。我也是个小菜鸟。刚入门的新手。

cutecpu

Sub demo()
   Set d = CreateObject("Scripting.Dictionary")
   a = Range([b1], [i1].End(4)): a(1, 1) = [y1]
   For i = 2 To UBound(a)
      For j = 2 To 8
         d(i & " " & a(i, j)) = 1
         If d(i - 1 & " " & a(i, j)) Then
            a(i, 1) = a(i, 1) & IIf(a(i, 1) > 0, "、", "") & a(i, j)
         End If
      Next
   Next
   [y1].Resize(UBound(a)) = a
End Sub

ruhong18

cutecpu 发表于 2021-10-16 19:06
Sub demo()
   Set d = CreateObject("Scripting.Dictionary")
   a = Range(, .End(4)): a(1, 1) = [y1] ...

你好版主，不知是2003版本原因还是，顿号出现乱码“*”，如图所示

ruhong18

ruhong18 发表于 2021-10-17 10:39
你好版主，不知是2003版本原因还是，顿号出现乱码“*”，如图所示

好的，谢谢您！辛苦您了！感恩，学习了~