[已解决]向右隔一格斜连，用VBA一直循环到下没有数据 。

爷们679

向右隔一格斜连，用VBA一直循环到下没有数据
向右隔一格斜连    如果是两个号码斜连的话，那么用填充颜色为红色。
向右隔一格斜连    如果是三个号码斜连的话，那么用填充颜色为黄色。
向右隔一格斜连    如果是四个号码以上（含四个号码）斜连的话，那么用填充颜色为蓝色。

最佳答案

月排行榜 / 总排行榜

AmoKat

2017-10-1 17:19

原來VBA稍修改就可以
Sub test()
    Dim m&, n&, k&, rag As Range, ragA As Range
    Application.ScreenUpdating = False
    Range("k6").CurrentRegion.Offset(5, 0).Interior.ColorIndex = -4142
    For Each rag In Range("k6").CurrentRegion.Offset(5, 0)
        If rag <> "" And rag.Interior.ColorIndex = -4142 Then
            Set ragA = rag: m = 1
            Do Until rag.Offset(m, m * 2) = ""
                Set ragA = Application.Union(ragA, rag.Offset(m, m * 2))
                m = m + 1
            Loop
            If m = 2 Then ragA.Interior.ColorIndex = 3
            If m = 3 Then ragA.Interior.ColorIndex = 45
            If m > 3 Then ragA.Interior.ColorIndex = 23
            m = 0
            Set rag = Nothing
        End If
    Next
    Application.ScreenUpdating = True
End Sub

跳转到最佳答案楼层

AmoKat

原來VBA稍修改就可以
Sub test()
    Dim m&, n&, k&, rag As Range, ragA As Range
    Application.ScreenUpdating = False
    Range("k6").CurrentRegion.Offset(5, 0).Interior.ColorIndex = -4142
    For Each rag In Range("k6").CurrentRegion.Offset(5, 0)
        If rag <> "" And rag.Interior.ColorIndex = -4142 Then
            Set ragA = rag: m = 1
            Do Until rag.Offset(m, m * 2) = ""
                Set ragA = Application.Union(ragA, rag.Offset(m, m * 2))
                m = m + 1
            Loop
            If m = 2 Then ragA.Interior.ColorIndex = 3
            If m = 3 Then ragA.Interior.ColorIndex = 45
            If m > 3 Then ragA.Interior.ColorIndex = 23
            m = 0
            Set rag = Nothing
        End If
    Next
    Application.ScreenUpdating = True
End Sub

idnoidno

還是沒看到附件，大哥，週日愉快，沒放假啊

爷们679

idnoidno 发表于 2017-10-1 11:43
還是沒看到附件，大哥，週日愉快，沒放假啊

已补发，工作表中有个宏可以参考。大哥，週日愉快

idnoidno

大哥，您這類型算是第二題了，第一題好像到現在還沒有人提供代碼，我一直苦思不得其門而入

爷们679

idnoidno 发表于 2017-10-1 13:06
大哥，您這類型算是第二題了，第一題好像到現在還沒有人提供代碼，我一直苦思不得其門而入

这个代码是热心网友写的。然后我想修改成新的代码（适合本工作表的宏），大哥，能帮我处理

idnoidno

樓上的已經給出
關鍵在於(m,m)------->(m.2*m)
呵呵

idnoidno

原代碼又學到了，真的，有學到，大哥謝謝提供解決的代碼方案

爷们679

idnoidno 发表于 2017-10-1 17:33
原代碼又學到了，真的，有學到，大哥謝謝提供解決的代碼方案

中间的一段我看不懂