用VBA编写一个彩票统计工具，怎样做成图表显示，麻烦帮忙看下

下面是一个自动生成图标的彩票程序，可以试试：

Sub lqxs()

Dim Arr, ks, js, nm1$, nm2$, dz1$, dz2$

Dim dz$, dz3$, yy$, nm$

Application.ScreenUpdating = False

Sheet3.Activate

Arr = [a1].CurrentRegion

ks = 3: js = UBound(Arr) - 1

    nm = Sheet3.Name

    yy = Left(nm, Len(nm) - 3)

    nm1 = "图表 6"

    nm2 = "图表 4"

    dz = "A2:B" & js & ",D2:E" & js

    ActiveSheet.ChartObjects(nm1).Activate

    With ActiveChart

        .SetSourceData Source:=Sheets(nm).Range(dz), PlotBy:=xlColumns

        .SeriesCollection(1).Select

        dz1 = "R3C2:R" & js & "C2"

        .SeriesCollection(1).Values = "='" & nm & "'!" & dz1

        dz2 = "R3C4:R" & js & "C4"

        .SeriesCollection(2).Values = "='" & nm & "'!" & dz2

        dz3 = "R3C5:R" & js & "C5"

        .SeriesCollection(3).Values = "='" & nm & "'!" & dz3

        .ChartTitle.Select

        Selection.Characters.Text = yy & "月份合格率"

    End With

    ActiveSheet.ChartObjects(nm2).Activate

    With ActiveChart

        .ChartArea.Select

        dz = "H2:T2,H" & js + 1 & ":T" & js + 1

        .SetSourceData Source:=Sheets(nm).Range(dz), PlotBy:= _

        xlRows

        dz2 = "R" & js + 1 & "C8:R" & js + 1 & "C20"

        .SeriesCollection(1).Values = "='" & nm & "'!" & dz2

        .ChartTitle.Select

        Selection.Characters.Text = yy & "月份不良趋势统计"

    End With

Range("A" & ks).Select

Application.ScreenUpdating = True

MsgBox "OK"

End Sub

本代码真正的大数据，大过滤，几百万次的计算可能只有一个号码，甚至一个都没有，可见，通过反复重算，光循环就是百万每次每位，每位进行2次循环，本代码会进入双色球，原理是一样的，几百万计算，只为了找一个号码！甚至一个都找不到，要求非常苛刻！

Sub 按钮877_Click()

Application.ScreenUpdating = False

Application.EnableEvents = False

Dim cs(), cs1(), cs2(), r1 As Range, r2 As Range, r10 As Range, ax&, i&, j&, m&, p&, k&, k1&, y&'不写r as range 结果写不出来

Dim a(1 To 10) As Integer, b(1 To 10) As Integer

ax = [a65536].End(xlUp).Row

Cells(3, 18).Resize(ax * 4, 20).ClearContents

cs = Range(Cells(1, 3), Cells(ax + 1, 8))

cs2 = Range(Cells(1, 19), Cells(ax * 9, 252))

Set r2 = Range(Cells(1, 19), Cells(ax, 126))

q = 0

For p = 1 To 500000，代码复杂，计算量非常大，光循环就是50万每次，可能一个都找不出来，要求非常苛刻！

'cs1 = Range(Cells(1, 18), Cells(ax, 18))

'Set r1 = Range(Cells(1, 18), Cells(ax, 18))

'Set r10 = Range(Cells(ax, 10), Cells(ax, 19))

本代码很快会进入双色球，原理是一样的，几百万计算，只为了找一个号码！

旋转矩阵是否选择性粘贴里面的转置，呢？如果是VBA代码如下：

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=True

---