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

laoau138

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

grf1973大侠也如此说

laoau138

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

发答案了，还有什么好办法，请发原贴啊

http://www.excelpx.com/thread-424862-1-1.html

wanao2008

这个应该也算吧？

laoau138

wanao2008 发表于 2016-10-11 22:16
这个应该也算吧？

这个也算了

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

http://www.excelpx.com/thread-424828-1-1.html

雄鹰2013

Sub 雄鹰()
Dim r
On Error Resume Next
Application.ScreenUpdating = False
t = Timer
r = Cells(Rows.Count, 1).End(xlUp).Row
Range("e11:t" & r).Interior.ColorIndex = 0
i = 11
Dim g1 As Range
Dim g2 As Range
Dim g3 As Range
Dim g4 As Range
For i = i To r '遍历每一行数据
     y = 1: x = 1
     Do While y < 7
        Set g1 = Range("e" & i & ":t" & i).SpecialCells(xlCellTypeFormulas, 1)
        Set g2 = Range("e" & i + x & ":t" & i + x).SpecialCells(xlCellTypeFormulas, 1)
        Set g3 = Range("e" & i + x + 1 & ":t" & i + x + 1).SpecialCells(xlCellTypeFormulas, 1)
        Set g4 = Range("e" & i + x + 2 & ":t" & i + x + 2).SpecialCells(xlCellTypeFormulas, 1)
        If g1 > g2 And g3 > g4 And (g1.Column - g2.Column) = (g3.Column - g4.Column) And (g1.Row - g3.Row) = (g2.Row - g4.Row) Or _
           g1 < g2 And g3 < g4 And (g2.Column - g1.Column) = (g4.Column - g3.Column) And (g3.Row - g1.Row) = (g4.Row - g2.Row) Then
          g1.Interior.ColorIndex = 14
          g2.Interior.ColorIndex = 14
          g3.Interior.ColorIndex = 14
          g4.Interior.ColorIndex = 14
        End If
        y = y + 1
        x = x + 1
     Loop
Next i
Application.ScreenUpdating = True
MsgBox Format(Timer - t, "0.00") & "秒"
End Sub

雄鹰2013

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

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

水平有限，只能做到这样了！其他的那个题请大神思考

laoau138

雄鹰2013 发表于 2016-10-14 18:25
Sub 雄鹰()
Dim r
On Error Resume Next

已经好高手了

laoau138

雄鹰2013 发表于 2016-10-14 18:27
水平有限，只能做到这样了！其他的那个题请大神思考

还有2条问题，你指哪一条不能做

用VBA改写过滤增加容错条件

http://www.excelpx.com/thread-424928-1-1.html


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

http://www.excelpx.com/thread-424828-1-1.html