vba 判断excel中数据是否重复_excel表格的基本操作-excel教程网

vba 判断excel中数据是否重复

时间:2014-10-21 15:22 来源:excel.org.cn 作者:admin 点击:次

Private Sub CommandButton1_Click()
    Dim c(256), sum(256), a(256), b(256)    As Variant    'c(256),sum(256) 获取单元格的值，a(256),b(256) 设置检查的列和列的字符长度
    Dim type1(100)                          As Variant    '保存每一列的类型
    Dim area(100, 100)                      As Variant    '保存数值类型的范围
    Dim i, j, m, s, y, count1, count, k, strlen As Long   'i,j用作循环,m,n 用作控制循环,count 记录有几列要检查,count1 有多少行数据
    Dim str, strMsg, str1   As String                   'str 获取列的字符串,str1 列的长度　strMsg 弹出信息
    Dim startValue, endValue As Integer                 'startValue 设置范围的默认起始值，endValue 默认终止值
    Dim line        As Integer                          '设置从第几行数据开始检查
    Dim str2        As String                           '设置每列的类型　str　字符型,num　数据型,date 日期型
    Dim flag        As Boolean                          '是否有重复值的条件，flag=true and s=1 时有重复值
    str = "2,3,4"                                         '设置选择的列数
    'str1 设置列的最大长度或数值的范围范围用 num-num 格式例如 1-2 如果为空则采用设定的默认值
    str1 = ""
    '设置列的数据类型　num 数值型，str　字符型,date 日期型,空为字符型
    str2 = "date,str,num"
    strlen = 10                                         '设置字符的默认长度
    startValue = 1                                      '设置数值范围的默认起始值
    endValue = 100                                     '设置数值范围的默认终止值
    m = InStr(1, str, ",")
    n = InStr(1, str1, ",")
    l = InStr(1, str2, ",")
    i = 1
    line = 1                                            '设置从第一行数据开始检查

    Do While 1 = 1
        If Cells(i, 1) = "" And Cells(i, 2) = "" And Cells(i + 1, 1) = "" And Cells(i + 1, 2) = "" Then
             Exit Do
        Else
             count1 = count1 + 1                        '计算有多少行数据
        End If
        i = i + 1
    Loop
    i = 0
    While m > 0
     a(i) = Left(str, m - 1) + 0                        '获取所设置的列
     If l = 0 Then
         type1(i) = "str"
     Else
         type1(i) = Left(str2, l - 1)
     End If
     If UCase(type1(i)) = "STR" Then                           '如果是字符型
        If n = 0 Then
          b(i) = Left(str1, n)                          '获取所设置的列的长度
        Else
          b(i) = Left(str1, n - 1)
        End If
        If b(i) = "" Then
          b(i) = strlen
        End If
     Else
        If UCase(type1(i)) = "NUM" Then                        '如果是数值型
           strsub = Left(str1, n - 1)
           l1 = InStr(1, strsub, "-")
           If l1 = 0 Or l1 = 1 Then
             area(i, 0) = startValue
             If Not VBA.IsNumeric(Right(strsub, Len(strsub) - l1)) Then
               area(i, 1) = endValue
             Else
               area(i, 1) = Right(strsub, Len(strsub) - l1)
             End If
           Else
             area(i, 0) = Left(strsub, l1 - 1)            '该列的范围
             If Not VBA.IsNumeric(Right(strsub, Len(strsub) - l1)) Then
               area(i, 1) = endValue
             Else
               area(i, 1) = Right(strsub, Len(strsub) - l1)
             End If
           End If
        End If
     End If
     str = Right(str, Len(str) - m)
     str1 = Right(str1, Len(str1) - n)
     str2 = Right(str2, Len(str2) - l)
     m = InStr(1, str, ",")
     n = InStr(1, str1, ",")
     l = InStr(1, str2, ",")
     i = i + 1
     count = count + 1                                 '得到要检查的列数
    Wend
    a(i) = str + 0                                     ' str+0 转换成数值型
    type1(i) = str2
    If UCase(type1(i)) = "STR" Then
      b(i) = str1
      If b(i) = "" Then
        b(i) = strlen
      End If
    Else
      If UCase(type1(i)) = "NUM" Then
         l1 = InStr(1, str1, "-")
         If l1 = 0 Or l1 = 1 Then
             area(i, 0) = startValue
             If Not VBA.IsNumeric(Right(str1, Len(str1) - l1)) Then
               area(i, 1) = endValue
             Else
               area(i, 1) = Right(str1, Len(str1) - l1)
             End If
         Else
             area(i, 0) = Left(str1, l1 - 1)            '该列的范围
             If Not VBA.IsNumeric(Right(str1, Len(str1) - l1)) Then
               area(i, 1) = endValue
             Else
               area(i, 1) = Right(str1, Len(str1) - l1)
             End If
         End If
      End If
    End If
    count = count + 1                        ' 判断共有几列数据要检查
    flag = True                              ' 设定相同值条件的初始值
    s = 0                                    ' s=0 是否有相同值的条件 0为没有相同的值
    m = 0                                    ' m=0 外循环条件
    n = 0                                    ' n=0 内循环条件
    i = 1                                    ' 设定从第一行开始判断
    Do While line <= count1 And m = 0
         For y = 0 To count - 1              ' 循环获取第y行 count 列的值
             c(y) = Cells(line, a(y))           ' 第i行　a(y) 列的值
             If c(y) = "" Then
                Cells(line, a(y)).Select
                strMsg = "no"
                MsgBox "该单元格的值不能为空值"
                Exit Do
             End If
             If UCase(type1(y)) = "STR" Then
                If Len(c(y)) > b(y) + 0 Then
                  Cells(line, a(y)).Select
                  strMsg = "no"
                  MsgBox "该单元格值的长度不能大于" + CStr(b(y))
                  Exit Do
                End If
             Else
                If UCase(type1(y)) = "NUM" Then
                  If VBA.IsNumeric(c(y)) Then
                     If c(y) < area(y, 0) + 0 Or c(y) > area(y, 1) + 0 Then
                       Cells(line, a(y)).Select
                       strMsg = "no"
                       MsgBox "该单元格的值不能小于 " + CStr(area(y, 0)) + " 或大于 " + CStr(area(y, 1))
                       Exit Do
                     End If
                  Else
                     Cells(line, a(y)).Select
                     strMsg = "no"
                     MsgBox "该单元格值的类型不正确,应该为数值型"
                     Exit Do
                  End If
                Else
                  If UCase(type1(y)) = "DATE" Then
                     If Not VBA.IsDate(c(y)) Then
                        Cells(line, a(y)).Select
                        strMsg = "no"
                        MsgBox "该单元格日期格式不正确！格式为年/月/日"
                        Exit Do
                     End If
                  End If
                End If
             End If
          Next y
          y = 0
          j = line + 1
          Do While j <= count1
             For y = 0 To count - 1         ' 循环获取 count 列的值
                s = 1
                sum(y) = Cells(j, a(y))     ' 第J行　a(y) 列的值
                If sum(y) = "" Then         ' 如果该列值为空退出循环
                   m = 1                    ' m=1退出外循环
                   Cells(j, a(y)).Select
                   strMsg = "no"
                   MsgBox "该单元格的值不能为空值"
                   Exit Do
                End If
                If UCase(type1(y)) = "STR" Then
                   If Len(sum(y)) > b(y) + 0 Then
                     m = 1                        ' m=1退出外循环
                     Cells(j, a(y)).Select
                     strMsg = "no"
                     MsgBox "该单元格的值长度不能大于" + CStr(b(y))
                     Exit Do
                   End If
                Else
                   If UCase(type1(y)) = "NUM" Then
                     If VBA.IsNumeric(sum(y)) Then
                       If sum(y) < area(y, 0) + 0 Or sum(y) > area(y, 1) + 0 Then
                         m = 1
                         Cells(j, a(y)).Select
                         strMsg = "no"
                         MsgBox "该单元格的值不能小于 " + CStr(area(y, 0)) + " 或大于 " + CStr(area(y, 1))
                         Exit Do
                       End If
                     Else
                         m = 1
                         Cells(j, a(y)).Select
                         strMsg = "no"
                         MsgBox "该单元格值的类型不正确,应该为数值型"
                         Exit Do
                     End If
                   Else
                     If UCase(type1(y)) = "DATE" Then
                        If Not VBA.IsDate(c(y)) Then
                           m = 1
                           Cells(j, a(y)).Select
                           strMsg = "no"
                           MsgBox "该单元格日期格式不正确！格式为年/月/日"
                           Exit Do
                        End If
                     End If
                   End If
                End If
                If c(y) = sum(y) Then       ' 判断是否值相同
                   flag = (flag And True)
                Else
                   flag = False
                End If
             Next y
             If flag And s = 1 Then         '如果值相同
                 strMsg = line
                 Cells(j, a(0)).Select
                 MsgBox "该单元格的值和第" + CStr(strMsg) + "行的值重复"
                 m = 1                      '退出循环
                 Exit Do                    '退出外循环
             End If
             flag = True
             s = 0
             j = j + 1                      '行加1
         Loop
         line = line + 1                          '行加1
    Loop
    If strMsg = "" Then
      MsgBox "没有相同的数据"
    End If
End Sub

(责任编辑：admin)