用VBA数组或字典计算A列数字数字连续次数

一把小刀闯天下

闻风上胆 发表于 2018-6-21 14:09
老师，麻烦你反向排列，谢谢您 ！！

'是这意思吗？来朵小花提点精神呀

Option Explicit

Sub test()
  Dim i, j, a, n, arr
  arr = Range("a1:a" & Cells(Rows.Count, "a").End(xlUp).Row + 1)
  ReDim brr(1 To Rows.Count, 1 To 1)
  For i = 1 To UBound(arr, 1) - 1
    For j = i To UBound(arr, 1) - 1
      If Len(arr(j, 1)) > 0 Then a = j: Exit For
    Next
    For j = a To UBound(arr, 1) - 1
      If Len(arr(j + 1, 1)) = 0 Then
        n = n + 1: brr(n, 1) = j - a + 1
        i = j: Exit For
      End If
  Next j, i
  j = Int(n / 2)
  For i = 1 To j
    a = brr(i, 1): brr(i, 1) = brr(n - i + 1, 1): brr(n - i + 1, 1) = a
  Next
  With [d1]
    .Resize(Rows.Count).ClearContents
    If n > 0 Then .Resize(n) = brr
  End With
End Sub

闻风上胆

一把小刀闯天下 发表于 2018-6-21 15:45
'是这意思吗？来朵小花提点精神呀

Option Explicit

老师。就是这结果，感谢您了！！祝你工作顺利！

闻风上胆

一把小刀闯天下 发表于 2018-6-21 15:45
'是这意思吗？来朵小花提点精神呀

Option Explicit

老师，f列不能识别，你刚才帮忙我做的是“连续",麻烦你帮忙把”遗漏“和”连续“弄到一个代码里面，并将f列的计算方式用代码实现，用一个控件完成。

f列的公式能说明怎么来的。具体表述可能说不清楚。


谢谢你老师！！！！

一把小刀闯天下

闻风上胆 发表于 2018-6-21 16:19
老师，f列不能识别，你刚才帮忙我做的是“连续",麻烦你帮忙把”遗漏“和”连续“弄到一个代码里面，并将f ...

看了一下，这么长的一个公式，我简单的公式都不会，也找不出规律，，，。

如果用文字表述然后配以效果图还好点，，，。

闻风上胆

一把小刀闯天下 发表于 2018-6-21 19:46
看了一下，这么长的一个公式，我简单的公式都不会，也找不出规律，，，。

如果用文字表述然后配以效果 ...

闻风上胆

一把小刀闯天下 发表于 2018-6-21 19:46
看了一下，这么长的一个公式，我简单的公式都不会，也找不出规律，，，。

如果用文字表述然后配以效果 ...

老师，这样能看明白吗？

一把小刀闯天下

'g列的数值不知道怎么来的。

'都是文字题，本来跑这里来是学VBA的，不过现在发现我的理解能力真的很差，很多问题竟然都看不懂！

'球赛马上要开始了，反正就这方法自己修改。

Option Explicit

Sub test()
  Dim i, arr, s1, s2, j, a, n
  arr = Range("c3:e" & Cells(Rows.Count, "c").End(xlUp).Row)
  s1 = [i1].Value: s2 = [j1].Value
  For i = 1 To UBound(arr, 1)
    arr(i, 1) = IIf((InStr(s1, arr(i, 1)) > 0 Or InStr(s1, arr(i, 2)) > 0 Or InStr(s1, arr(i, 3)) > 0) And (InStr(s2, arr(i, 1)) > 0 Or InStr(s2, arr(i, 2)) > 0 Or InStr(s2, arr(i, 3)) > 0), 1, vbNullString)
  Next
  [f3].Resize(UBound(arr, 1)) = arr '写入f列
  arr = Range("f3:f" & Cells(Rows.Count, "f").End(xlUp).Row + 1)
  ReDim brr(1 To UBound(arr, 1), 1 To 1)
  For i = 1 To UBound(arr, 1) - 1
    For j = i To UBound(arr, 1) - 1
      If Len(arr(j, 1)) > 0 Then a = j: Exit For
    Next
    For j = a To UBound(arr, 1) - 1
      If Len(arr(j + 1, 1)) = 0 Then
        n = n + 1: brr(a, 1) = j - a + 1
        i = j: Exit For
      End If
  Next j, i
'  For i = 1 To Int(UBound(arr, 1) / 2)
'    a = brr(i, 1)
'    brr(i, 1) = brr(UBound(brr, 1) - i + 1, 1): brr(UBound(brr, 1) - i + 1, 1) = a
'  Next
  With [i3] '连续统计，写入i列
    .Resize(Rows.Count - 2).ClearContents
    .Resize(n) = brr
  End With
End Sub

闻风上胆

一把小刀闯天下 发表于 2018-6-21 22:59
'g列的数值不知道怎么来的。

'都是文字题，本来跑这里来是学VBA的，不过现在发现我的理解能力真的很差， ...

虽然不知道能不能改好，但真心谢谢你的帮忙 !!!!