[已解决]求vb

mhjbgf

book1.rar (94.43 KB, 下载次数: 6)

2014-1-3 14:16 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

上清宫主

2014-1-4 09:13

Sub test()
Dim d1 As New Dictionary, d2 As New Dictionary, ar1(), ar2(1 To 100, 1 To 1)
For i1% = 1 To Sheets.Count - 1
   For i2% = i1 To i1 + 1
       ar1 = Sheets(i2).[e2].CurrentRegion.Value
       For i3% = 1 To UBound(ar1, 2)
           For i4% = 1 To UBound(ar1)
               If ar1(i4, i3) = "" Then Exit For
               d1(ar1(i4, i3)) = d1(ar1(i4, i3)) + 1
           Next
           For Each tmp In d1.Keys
               If d1(tmp) = 1 Then d2(tmp) = d2(tmp) + 1
           Next
           d1.RemoveAll
       Next
   Next
   For Each tmp In d2.Keys
       If d2(tmp) > 2 Then
          If r% >= 100 Then
             Sheets(1).[b65536].End(3)(2).Resize(r) = ar2
             r = 0
          End If
          r = r + 1
          ar2(r, 1) = tmp
       End If
   Next
   d2.RemoveAll
Next
If r Then Sheets(1).[b65536].End(3)(2).Resize(r) = ar2
End Sub

跳转到最佳答案楼层

上清宫主

看漏了，待会传

上清宫主

Sub test()
Dim d1 As New Dictionary, d2 As New Dictionary, ar1(), ar2(1 To 100, 1 To 1)
For i1% = 1 To Sheets.Count - 1
   For i2% = i1 To i1 + 1
       ar1 = Sheets(i2).[e2].CurrentRegion.Value
       For i3% = 1 To UBound(ar1, 2)
           For i4% = 1 To UBound(ar1)
               If ar1(i4, i3) = "" Then Exit For
               d1(ar1(i4, i3)) = d1(ar1(i4, i3)) + 1
           Next
           For Each tmp In d1.Keys
               If d1(tmp) = 1 Then d2(tmp) = d2(tmp) + 1
           Next
           d1.RemoveAll
       Next
   Next
   For Each tmp In d2.Keys
       If d2(tmp) > 2 Then
          If r% >= 100 Then
             Sheets(1).[b65536].End(3)(2).Resize(r) = ar2
             r = 0
          End If
          r = r + 1
          ar2(r, 1) = tmp
       End If
   Next
   d2.RemoveAll
Next
If r Then Sheets(1).[b65536].End(3)(2).Resize(r) = ar2
End Sub

上清宫主

If d2(tmp) > 2 Then是大于等于3的都取出来。如果是其它自行修改