请高手用VBA帮我完成表格中的内容

hbhsfeng

excelvlookup 发表于 2018-9-30 23:13
买彩票的，这个难道还没解决吗？

按新图表说明解决。你可以帮我解决吧!

excelvlookup

Sub aa()
rw = Sheet1.Cells(Rows.Count, 3).End(3).Row
ar = Sheet1.Range("c4:e" & rw)
ReDim br(1 To 3, 9, 1 To UBound(ar))
ReDim cr(1 To 3, 9, 1 To UBound(ar))
For i = 1 To UBound(ar)
    For j = 1 To 3
        cr(j, ar(i, j), i) = ar(i, j)
        For k = 0 To 9
            If cr(j, k, i) = "" Then
                If i = 1 Then
                    br(j, k, i) = 1
                Else
                    br(j, k, i) = br(j, k, i - 1) + 1
                    br(j, k, i - 1) = ""
                End If
            Else
                br(j, k, i) = 0
            End If
        Next
    Next
Next
For i = 1 To 3
    ReDim rr(1 To UBound(ar), 9)
    For j = 0 To 9
        For k = 1 To UBound(ar)
            If cr(i, j, k) <> "" Then
                rr(k, j) = cr(i, j, k)
            Else
                rr(k, j) = br(i, j, k)
            End If
        Next
    Next
    Sheet1.Cells(4, (i - 1) * 10 + 6).Resize(UBound(ar), 10) = rr
Next
End Sub

Sub bb()
rw = Sheet1.Cells(Rows.Count, 3).End(3).Row
ar = Sheet1.Cells(rw - 1, 6).Resize(2, 30)
br = Sheet1.Cells(rw - 1, 3).Resize(2, 3)
If Application.Sum(Range("f" & rw & ":ai" & rw)) = 0 Then
For i = 1 To 3
    For j = 1 To 10
        If j - 1 = br(1, i) Then
            ar(2, (i - 1) * 10 + j) = 1
        Else
            ar(2, (i - 1) * 10 + j) = ar(1, (i - 1) * 10 + j) + 1
            If j - 1 <> br(2, i) Then
                ar(1, (i - 1) * 10 + j) = ""
            End If
        End If
    Next
    ar(2, (i - 1) * 10 + br(2, i) + 1) = br(2, i)
Next
Sheet1.Cells(rw - 1, 6).Resize(2, 30) = ar
End If
End Sub
全表重写用aa()，不重写用bb()，bb()必须最少有两期号码，且如果前期计算错误会一直错下去。
即使有aa()重写全表，计算一万个号码也不超过1秒。VBA没有你18楼所说的局限性。

hbhsfeng

你的代码(sub bb)放进入没有反应。第一个代码放进去，如你所说的，很快。你果然是高手中的高手。太感谢你了!

hbhsfeng

你的代码有点问题。我加了数据测试了一下。
你看下面的截图。

excelvlookup

说清楚，什么地方不对？？？？

hbhsfeng

excelvlookup 发表于 2018-10-1 21:29
说清楚，什么地方不对？？？？

你看上面的截图就知道。最后两行号码，把号码填充在表格右边，没有显示茶色底纹。

hbhsfeng

excelvlookup 发表于 2018-10-1 21:29
说清楚，什么地方不对？？？？

你看上面的截图就知道。最后两行号码，把号码填充在表格右边，没有显示茶色底纹。

hbhsfeng

我把11楼的代码加在表格中，把这句代码Cells(i, a + (j - 1) * 10 + 6).Interior.ColorIndex = j +33，改为Cells(i, a + (j - 1) * 10 + 6).Interior.ColorIndex = 40，因为我不想要三种底纹。后来看到你写的代码，把他的代码清除，把你的代码加进入，就出现上面截图的情况。
你的代码没有设置号码底纹，现在知道原因出在什么地方，就好解决。请问这句代码：Interior.ColorIndex = 40（茶色代码）加在什么地方。

excelvlookup

hbhsfeng 发表于 2018-10-2 07:22
你看上面的截图就知道。最后两行号码，把号码填充在表格右边，没有显示茶色底纹。

用条件格式吧，否则会影响速度

hbhsfeng

条件格式有点不好写，我写了好几次没有成功，把遗漏值当作号码填充为茶色。
我要的是号码为茶色底纹，字体为黑色，遗漏值字体为灰色。