Question

excel vba提取填充颜色到指定位置

1.条件为R1 这里可以自由修改

Answer 1

Sub s()
    Dim rg1 As Range, rg2 As Range, rg As Range
    Set rg1 = [r1]
    Set rg2 = [r5:aa14]
    c = 11
    e = 50
    For Each rg In rg2
        If rg.Text = rg1.Text Then
            t = rg.Interior.ColorIndex
            If t = xlNone Then t = 8
            Do While Cells(e, c).Interior.ColorIndex <> xlNone
                e = e + 1
            Loop
            Cells(e, c).Interior.ColorIndex = t
        End If
    Next
End Sub