关于字典统计

coden0906

论坛大大好：
       小白刚接触字典，觉得很强大，正在自学摸索中，恳请各位大大指点。
已知设置表（横向和纵向无限扩展）


需要统计表（黄色部分用VBA自动统计）：


说明事项：
用统计表里的时间去匹对设置表列D开始后的时间区间，用统计表的活动内容去匹对设置表的列A的活动名称，用统计表的抽取号码匹对设置表的号码区间范围。如果对应的设置表内的奖品名称（100X 四位代码）为空，那么就对应长期的奖品名称（详见统计表孙九的例子）。
不知道表述清楚了没，由于比较复杂，请各位大大看看是否可以用字典的方法实现，多谢！
附件如下：
样表.zip (7.98 KB, 下载次数: 15)

2018-7-13 15:21 上传

点击文件名下载附件

stonelee2018

说的比较复杂，听的比较懵

一把小刀闯天下

'无需字典，不过确实挺复杂，而且使用字典也不合适

Option Explicit

Sub test()
  Dim i, j, k, s, arr, brr, dt, t
  arr = Sheets("活动设置").[a1].CurrentRegion
  brr = Sheets("统计表").[a1].CurrentRegion
  ReDim crr(1 To UBound(brr, 1) - 1, 1 To 1)
  For i = 2 To UBound(brr, 1)
    dt = CDate(brr(i, 1))
    For j = 4 To UBound(arr, 2)
      If InStr(arr(1, j), "-") Then
        t = Split(arr(1, j), "-")
        t(0) = CDate(Replace(t(0), ".", "-"))
        t(1) = CDate(Replace(t(1), ".", "-"))
        If dt >= CDate(t(0)) And dt <= CDate(t(1)) Then
          For k = 2 To UBound(arr, 1)
            If brr(i, 2) = arr(k, 1) Then
              s = Split(arr(k, 2), "-")
              If brr(i, 4) >= Val(s(0)) And brr(i, 4) < _
                Val(s(1)) Then crr(i - 1, 1) = arr(k, j): Exit For
            End If
          Next
        End If
      End If
    Next
    If Len(crr(i - 1, 1)) = 0 Then
      For j = 2 To UBound(arr, 1)
        If brr(i, 2) = arr(j, 1) Then
          s = Split(arr(j, 2), "-")
          If brr(i, 4) >= Val(s(0)) And brr(i, 4) < _
            Val(s(1)) Then crr(i - 1, 1) = arr(j, 3): Exit For
        End If
      Next
    End If
  Next
  Sheets("统计表").[f2].Resize(UBound(crr, 1)) = crr '作比较用
End Sub

coden0906

一把小刀闯天下 发表于 2018-7-13 16:00
'无需字典，不过确实挺复杂，而且使用字典也不合适

Option Explicit

大大好厉害，这么复杂也实现了，我自己慢慢学习消化下，谢谢大大

一把小刀闯天下

coden0906 发表于 2018-7-13 21:34
大大好厉害，这么复杂也实现了，我自己慢慢学习消化下，谢谢大大

字典也可以实现，看了一下目测需要3个字典，而且代码写起来比用纯数组处理可能还要复杂些。因为类似于这种问题数据量不会很大，觉得还是用纯数组来处理更靠谱些