请问如何实现不重复抽取？

harrisondan2000

jiminyanyan 发表于 2018-6-24 21:22
Option Explicit

Sub jimin()

嘿嘿，我再来叨扰一下，请问怎么把这个子过程做成以下函数呢，能随时调用，我这边想针对不同的员工筛不懂数量的工单，我尝试了一下，给定两个参数，（不同员工工单组成的数组），筛选个数，但是总是不行，在网上也搜了一下如何调用函数用给定的数组作为参数，返回一个新的数组，但没明白。以下是您的代码改了一下, 数据源还是原来的压缩文件，只不过根据员工名称分成了多个数组：
Function test_02(SourceData, L)
  Dim dic(2), i, t, arr, m, n, s, key
  For i = 0 To UBound(dic)
    Set dic(i) = CreateObject("scripting.dictionary")
  Next
  arr = SourceData()
  For i = 1 To UBound(arr, 1)
    If dic(0).exists(arr(i, 1)) Then
      t = dic(0)(arr(i, 1))
      ReDim Preserve t(UBound(t) + 1)
      t(UBound(t)) = arr(i, 3)
      dic(0)(arr(i, 1)) = t
      dic(2)(arr(i, 3)) = arr(i, 4)
      dic(3)(arr(i, 3)) = arr(i, 5)
    Else
      dic(0)(arr(i, 1)) = Array(arr(i, 3))
      dic(1)(arr(i, 1)) = arr(i, 2)
      dic(2)(arr(i, 3)) = arr(i, 4)
    End If
  Next
  
  If L = 1 Then
    ReDim brr(1 To dic(0).Count, 1 To 5) As String
    Randomize
    For Each key In dic(0).keys
      t = dic(0)(key)
      For i = 0 To UBound(t)
        m = Int(Rnd * (UBound(t) + 1))
        s = t(i): t(i) = t(m): t(m) = s
      Next
      s = dic(1)(key)
      n = n + 1
      brr(n, 1) = key: brr(n, 3) = t(0)
      brr(n, 2) = s: brr(n, 4) = dic(2)(t(0))
    Next
    test_02 = brr
  End If
  
  If L = 2 Then
    ReDim brr(1 To dic(0).Count * 2, 1 To 5) As String
    Randomize
    For Each key In dic(0).keys
      t = dic(0)(key)
      For i = 0 To UBound(t)
        m = Int(Rnd * (UBound(t) + 1))
        s = t(i): t(i) = t(m): t(m) = s
      Next
      s = dic(1)(key)
      n = n + 1
      brr(n, 1) = key: brr(n, 3) = t(0)
      brr(n, 2) = s: brr(n, 4) = dic(2)(t(0))
      If UBound(t) > 0 Then
      n = n + 1
      brr(n, 1) = key: brr(n, 3) = t(1)
      brr(n, 2) = s: brr(n, 4) = dic(2)(t(1))
      End If
    Next
    test_02 = brr
  End If
  
  If L = 3 Then
    ReDim brr(1 To dic(0).Count * 3, 1 To 5) As String
    Randomize
    For Each key In dic(0).keys
      t = dic(0)(key)
    For i = 0 To UBound(t)
        m = Int(Rnd * (UBound(t) + 1))
        s = t(i): t(i) = t(m): t(m) = s
      Next
      s = dic(1)(key)
      n = n + 1
      brr(n, 1) = key: brr(n, 3) = t(0)
      brr(n, 2) = s: brr(n, 4) = dic(2)(t(0))
      If UBound(t) > 0 And UBound(t) <= 1 Then
      n = n + 1
      brr(n, 1) = key: brr(n, 3) = t(1)
      brr(n, 2) = s: brr(n, 4) = dic(2)(t(1))
      End If
      If UBound(t) > 1 Then
       n = n + 1
        brr(n, 1) = key: brr(n, 3) = t(1)
        brr(n, 2) = s: brr(n, 4) = dic(2)(t(1))
        n = n + 1
        brr(n, 1) = key: brr(n, 3) = t(2)
        brr(n, 2) = s: brr(n, 4) = dic(2)(t(2))
      End If
    Next
    test_02 = brr
  End If
  
End Function

harrisondan2000

希望可以得到大神的解答~万分感谢。

harrisondan2000

ReDim brr(1 To dic(0).Count * 3, 1 To 5)里面的1 to 5应该是1 to 4~

harrisondan2000

我自己琢磨出来了，谢谢。