工作中十万火急的难题难倒了我这个VBA小白，希望高手能够赐个代码，万分感谢

玫瑰蝴蝶雨

工作中十万火急的难题难倒了我这个VBA小白，希望高手能够赐个代码，万分感谢

各位大神、各位高手，大家好！
  本人工作中遇到一个棘手问题，因为不会VBA，变得非常不好处理，所以来求助大家，希望得到大家的帮助：
我工作中有个表格，记录每台机器加工到了哪一道工序，表格的J列和K列合并到一起代表机器的订单编号（例如J2&K2与J3&K3相同，所以是同一台机器的零件，而J3&K3与J4&K4不同，所以代表不是同一台机器），因为每天有非常多的零件需要用到这个表，所以为了方便区分我想用两种不同的颜色来交替填充不同的零件行达到区分不同订单的目的例如附件和图片显示的样子（使用的颜色最好能弹出来对话框由用户自己定义，实在难以完成就当我这句话没说）如果J&K为空则不填充。请哪位高手费心帮忙实现下，万分感谢！

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr, zrr()
   
4.   With Worksheets(1)
   
5.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
6.     arr = .Range("j1:k" & r)
   
7.     xm = ""
   
8.     For i = 2 To UBound(arr)
   
9.       If arr(i, 1) & "+" & arr(i, 2) <> xm Then
   
10.         m = m + 1
    
11.         ReDim Preserve zrr(1 To 2, 1 To m)
    
12.         zrr(1, m) = i
    
13.         zrr(2, m) = i
    
14.         xm = arr(i, 1) & "+" & arr(i, 2)
    
15.       Else
    
16.         zrr(2, m) = i
    
17.       End If
    
18.     Next
    
19.     .Rows("2:" & r).Interior.ColorIndex = xlNone
    
20.     For k = 1 To UBound(zrr, 2)
    
21.       .Rows(zrr(1, k) & ":" & zrr(2, k)).Interior.ColorIndex = IIf(k Mod 2 = 1, 8, 15)
    
22.     Next
    
23.   End With
    
24. End Sub
    

复制代码

chxw68

      .Rows(zrr(1, k) & ":" & zrr(2, k)).Interior.ColorIndex = IIf(k Mod 2 = 1, 8, 15) ‘如果对颜色不满意请修改括号中的8和15。

chxw68

详见附件。

小花鹿

Sub test()
Dim sht, r&, n&, s, s1, i&, j&, ar
Set sht = Sheets("F1催单+尾巴+配套")
r = sht.Range("j65536").End(3).Row
ar = sht.Range("j1:k" & (r + 1))
For i = 2 To r
    For j = i + 1 To r + 1
        If (ar(j, 1) & ar(j, 2)) <> (ar(i, 1) & ar(i, 2)) Then
            n = n + 1
            If n Mod 2 Then
                sht.Rows(i & ":" & (j - 1)).Interior.Color = RGB(255, 0, 0)
            Else
                sht.Rows(i & ":" & (j - 1)).Interior.Color = RGB(0, 255, 0)
            End If
            i = j - 1
            Exit For
        End If
    Next j
Next i
End Sub

玫瑰蝴蝶雨

chxw68 发表于 2018-9-18 21:18
详见附件。

谢谢您这么晚了还为我的事费心，我明天到公室就测试下，特别感谢您！谢谢！

chxw68

色彩对应值列表。

玫瑰蝴蝶雨

chxw68 发表于 2018-9-18 21:42
色彩对应值列表。

谢谢，谢谢，真的非常感谢！！！

玫瑰蝴蝶雨

小花鹿 发表于 2018-9-18 21:34
Sub test()
Dim sht, r&, n&, s, s1, i&, j&, ar
Set sht = Sheets("F1催单+尾巴+配套")

谢谢您，我今天到公司就去试一下，感谢您昨晚那么晚了还帮我写代码，谢谢！

玫瑰蝴蝶雨

chxw68 发表于 2018-9-18 21:16

您好，谢谢您给我的帮助，今天测试了一下，其他都好用，就是“如果J&K为空则不填充”这句不起作用，程序把所有挨着的空单元格当成相同的去标注颜色了。您在帮忙看看。