如何用VBA提取复选框中的数字

hbhsfeng

如何用VBA提取控件中复选框中的数字，到对应的表格中。见表格说明。

不知道为什么

玩彩票的就是对自己要求太苛刻了。又要赚钱还要费神的去专研代码，辛苦！

microyip

这种~赌~博~用的，应该找那些提供有偿服务的专业人士处理啊

一把小刀闯天下

图表1.rar (27.31 KB, 下载次数: 15)

2018-8-6 15:25 上传

点击文件名下载附件

Option Explicit

Sub test()
  Dim shp, i, n
  ReDim arr(1 To 33), brr(1 To 16)
  With Sheets("图表")
    For i = 1 To .Shapes.Count
      If InStr(.Shapes(i).Name, "Check") = 1 Then
        If .OLEObjects(.Shapes(i).Name).Object.Value Then
          n = Val(Replace(.Shapes(i).Name, "CheckBox", vbNullString))
          If n <= 33 Then
            arr(n) = n
          Else
            brr(n - 33) = n - 33
          End If
        End If
      End If
    Next
    Call dsort(arr): Call getdata(arr): .[c5].Resize(, UBound(arr)) = arr
    Call dsort(brr): Call getdata(brr): .[c6].Resize(, UBound(brr)) = brr
  End With
End Sub

Function getdata(arr)
  Dim i, j, n
  For i = 1 To UBound(arr)
    If arr(i) > 0 Then
      For j = i To UBound(arr)
        n = n + 1: arr(n) = arr(j): arr(j) = vbNullString
      Next
      Exit Function
    End If
  Next
End Function

Function dsort(arr)
  Dim i, j, t
  For i = 1 To UBound(arr) - 1
    For j = i + 1 To UBound(arr)
      If arr(i) > arr(j) Then t = arr(i): arr(i) = arr(j): arr(j) = t
  Next j, i
End Function

hbhsfeng

代码如何添加进入，我对VBA不懂。

hbhsfeng

我说的是只钩数字，就出现数字，去钩就去数字。当然你的代码也可以实现，要点两下，太麻烦了。设置清除数据按钮是为了方便重新输入数字。
有没有别的代码。

hbhsfeng

我在该网站下载了这样的表格，可是别人加了密码。我需要的就是这样的表格。如何把我上面的表格制作成这样子。
见别人表格的样子。

一把小刀闯天下

hbhsfeng 发表于 2018-8-6 15:42
我说的是只钩数字，就出现数字，去钩就去数字。当然你的代码也可以实现，要点两下，太麻烦了。设置清除数据 ...

可以用类模块来写，有点费劲，代码我就不写了，这问题本来就是体力活

你多点一下按钮都觉得麻烦，用类模块来写比多点击一次按钮可麻烦多了，哈哈哈，，，

不知道为什么

hbhsfeng 发表于 2018-8-6 15:55
我在该网站下载了这样的表格，可是别人加了密码。我需要的就是这样的表格。如何把我上面的表格制作成这样子 ...

这个附件很不错啊，你可以直接拿着就用啊

hbhsfeng

我是为了做数据对比，才发这样的帖子，这与赌博没有关系。别人做的表格好，但是没有蓝球号码。