用VBA判断平行四边形填充绿色底单元格

today0427

laoau138 发表于 2016-10-2 18:10
高手再看这个

用VBA推算组成平行四边形最后一个数字

赶紧给grf1973老师评最佳，他没给你单元格变颜色是因为没法变，重复单元格太多，要变全都变了，没意义，显示组合你能看得更清楚

laoau138

today0427 发表于 2016-10-2 18:28
赶紧给grf1973老师评最佳，他没给你单元格变颜色是因为没法变，重复单元格太多，要变全都变了，没意义， ...

别急了，立即最佳答案，

today0427

laoau138 发表于 2016-10-2 18:31
别急了，立即最佳答案，

我也要好好学习下

grf1973

today0427 发表于 2016-10-2 18:26
大神，有空帮我看看为什么我的结果比你少了好多组，查看了你的结果确实对着，但是我的代码哪里有漏洞了？ ...

你得把你的思路介绍一下，代码加一点说明，尤其是2个函数实现什么功能。
读程序比自己编要难得多。

today0427

grf1973 发表于 2016-10-2 20:00
你得把你的思路介绍一下，代码加一点说明，尤其是2个函数实现什么功能。
读程序比自己编要难得多。

我已经找到原因了大神，咱俩对十行的理解不一样，您理解为从第一行往下再找10行，我理解的是包含第一行在内共找10行，因此，对于循环的最大下标限定不一样，所以结果不同。
函数我也不懂，照猫画虎，糊里糊涂做的，我是担心在一个子过程中循环嵌套太多我会被自己给绕进去，所以分开来做了

pengyx

最简单的方法，列出所有组合，一个个去校验代码如下：
Sub peng()
rw = Range("a65536").End(3).Row
ar = Range("e11:t" & rw)
ReDim br(1 To UBound(ar), 1 To 2)
Dim cr(1 To 100000, 1 To 2)
For i = 1 To UBound(ar)
    For j = 1 To UBound(ar, 2)
        If ar(i, j) <> "" Then
            br(i, 1) = i: br(i, 2) = j
            Exit For
        End If
    Next
Next
For a = 1 To UBound(ar) - 9
    For b = a + 1 To a + 7
        For c = b + 1 To a + 8
            For d = c + 1 To a + 9
                If a - b = c - d And br(a, 2) - br(c, 2) = br(b, 2) - br(d, 2) Then
                n = n + 1
                cr(n, 1) = br(a, 2) & "|" & br(b, 2) & "|" & br(c, 2) & "|" & br(d, 2)
                cr(n, 2) = a & "|" & b & "|" & c & "|" & d
                End If
            Next
        Next
    Next
Next                  
Cells(11, 23).Resize(n, 2) = cr
End Sub

today0427

pengyx 发表于 2016-10-6 21:47
最简单的方法，列出所有组合，一个个去校验代码如下：
Sub peng()
rw = Range("a65536").End(3).Row

大神，你看看那个垂直对角线的题目，有没有什么简便的办法

pengyx

垂直对角线的题目,在什么地方

today0427

pengyx 发表于 2016-10-6 22:15
垂直对角线的题目,在什么地方

http://www.excelpx.com/thread-424862-1-1.html这个，我想了半天，感觉自己做出来会比他原来自带的那个还要复杂，有没有什么简单巧妙的思路

laoau138

today0427 发表于 2016-10-6 22:45
http://www.excelpx.com/thread-424862-1-1.html这个，我想了半天，感觉自己做出来会比他原来自带的那个 ...

这题有答案