考虑到用窗体和控件在这里不方便，就用INPUTBOX来代替了 Sub xm() Dim xm$, ys1%, ys%, rn As Range xm = InputBox("请输入要查询的姓名，并输入显示背景颜色代码，例如：张三，1" & vbCr & "红色 绿色 蓝色 黄色 紫色 青色 桔色") xm = Replace(xm, "，", ",") If IsNumeric(Split(xm, ",")(1)) Then If InStr(xm, ",") Then ys1 = Split(xm, ",")(1) Select Case ys1 Case 1 ys = 3 Case 2 ys = 4 Case 3 ys = 5 Case 4 ys = 6 Case 5 ys = 7 Case 6 ys = 8 Case Else ys = 46 End Select End If For Each rn In SUsedRange If Value = Split(xm, ",")(0) Then IColorIndex = ys Next Else MsgBox "输入有误，请重新输入" End IfEnd Sub
你这样只能遍历整行才行，但是有个问题，比如：第1行为：1 2 3 4 1 2 3 4 ，像这样的数据，1234都重复了一遍，那整行都是蓝色的，是否重复数据只有一个？如果多个重复数据，那做了和没做没啥区别，只是知道它重复了。代码如下：Sub a() '被重复和重复的都筛选Dim i As LongDim j As LongDim k As LongFor i = 3 To Range("A3")End(xlDown)Row For j = 1 To Cells(i, 1)End(xlToRight)Column For k = 1 To Cells(i, 1)End(xlToRight)Column If j = k Then GoTo l1 End If If Cells(i, j) = Cells(i, k) Then Cells(i, j)IColorIndex = 5 End Ifl1: Next k Next jNext iEnd SubSub b() '只筛选被重复的，不筛选重复的Dim i As LongDim j As LongDim k As LongFor i = 3 To Range("A3")End(xlDown)Row For j = 1 To Cells(i, 1)End(xlToRight)Column For k = j + 1 To Cells(i, 1)End(xlToRight)Column If Cells(i, j) = Cells(i, k) Then Cells(i, j)IColorIndex = 5 End If Next k Next jNext iEnd Sub这里做了两个，一个只筛选一半，一个全部筛选，你试试，有疑问再追问。望采纳，谢谢。
1、首先打开需要编辑的Excel表格，右键单击工作表的标签，选择打开“查看代码”。2、然后在弹出来的窗口中点击输入：Sub 删除重复行()Dim xRow As IntegerDim i As IntegerxRow = Range("B65536")End(xlUp)RowFor i = 2 To xRowFor j = i + 1 To xRowIf Cells(j, 2) = Cells(i, 2) ThenRange(Cells(j, 1), Cells(j, 256))RDeletej = j - 1xRow = xRow - 1End IfNextNextEnd Sub3、然后点击左上角的保存按钮进行保存，之后运行该代码或运行宏“删除重复行”即可。4、然后就可以删除重复数据的整行。
Sub test()Dim arr, c, a&arr = Intersect(Range("a:d"), ActiveSUsedRange)Set Zd = CreateObject("dictionary")For Each c In arrIf c <> "" Then a = Zd(c): Zd(c) = a + 1Next[f2]Resize(ZCount) = ATranspose(Zkeys)[g2]Resize(ZCount) = ATranspose(Zitems)End Sub
直接在B列录入公式就能实现B1=IFERROR(MATCH(C1,A:A,0),"不重复")向下填充，在C列输入内容，如果重复了就会显示数字，指出重复数据在A列的位置，不重复就显示不重复
请把你的情况说明的再具体点
不太明白，发个文件来理解一下
你带行列号截图上来看看。另结果不应在同一单元格内，会入嵌套死循环的。
图中的Day4是需要删除的？
Private Sub CommandButton1_Click() TextBText = "" For r = 1 To Range("a65536")End(xlUp)Row If Cells(r, 1)Value = TextBText And Cells(r, 2)Value = TextBText Then TextBText = Cells(r, 3)Value Exit For End If NextEnd Sub
考虑到用窗体和控件在这里不方便，就用INPUTBOX来代替了 Sub xm() Dim xm$, ys1%, ys%, rn As Range xm = InputBox("请输入要查询的姓名，并输入显示背景颜色代码，例如：张三，1" & vbCr & "红色 绿色 蓝色 黄色 紫色 青色 桔色") xm = Replace(xm, "，", ",") If IsNumeric(Split(xm, ",")(1)) Then If InStr(xm, ",") Then ys1 = Split(xm, ",")(1) Select Case ys1 Case 1 ys = 3 Case 2 ys = 4 Case 3 ys = 5 Case 4 ys = 6 Case 5 ys = 7 Case 6 ys = 8 Case Else ys = 46 End Select End If For Each rn In SUsedRange If Value = Split(xm, ",")(0) Then IColorIndex = ys Next Else MsgBox "输入有误，请重新输入" End IfEnd Sub