VBA----查找 Excel 表每个sheet的第1列,是否存在重复值

 

代码准备放到关闭表前,报错

 

 

 

这个代码还有点问题

 

Sub jackxxx1()


'先撸有几张表,表名存入数组中
Dim arr1()
Dim arr2()
Dim dic1 As Object



k = 0
wkn1 = ThisWorkbook.Name
Set dic1 = CreateObject("scripting.dictionary")


For Each sh1 In Workbooks(wkn1).Sheets
   ReDim arr1(k)
   arr1(k) = sh1.Name
   k = k + 1
Next

'先撸有几张表,每张英文表名的第1列,都要检查重复,这里得写循环




'第1列先存进去

arr2() = Range("a1" & ":" & "a" & Range("a65535").End(xlUp).Row)


k1 = dic1.keys
it1 = dic1.items

For Each sh1 In Workbooks(wkn1).Sheets
    For i = 1 To UBound(arr2(), 1)
       dic1(arr2(i, 1)) = dic1(arr2(i, 1)) + 1
'       If dic1(arr2(i, 1)) >= 0 Then
'          Cells(i, 1).Interior.ColorIndex = 6
'       End If
    Next i
Next



'For Each x In dic1.keys()
'        Debug.Print dic1.k1(x)
'Next x
'
'
'For Each y In dic1.items()
'        Debug.Print dic1.it1(y)
'Next y




'x12 = dic1.keys.Count
'For x11 = 0 To (x12 - 1)
'   Debug.Print dic1.keys()(x11)
'   Debug.Print dic1.items()(x11)
'   Debug.Print ""
'Next





'k1 = dic1.keys
'it1 = dic1.items
'For Each j In it1
'  If j >= 2 Then
'
''    x1 = it1(m)
''    m = m + 1
''    MsgBox x1
''   MsgBox k1(Application.Match(it1(j), it1, 0) - 1)
''  MsgBox dic1.keys(Application.Match(dic1.items(j), dic1.items, 0))
'
' '改颜色
'
' '通知
'  MsgBox "存在重复值"
'  '退出
'  Exit Sub
'  End If
'Next j


For Each j In dic1.items
  If j >= 2 Then
  MsgBox "存在重复值"
  Exit Sub
  End If
Next j


'指定某几个表的,某一列,需要特别查ID引用是否为空的问题


End Sub

 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值