Question

excel vba提取无填充颜色单元内容到另表

1。表一（D8：I16）无填充颜色单元内容到另表

Answer 1

Sub xx()
    Const t = 2
    a = String(t, "X")
    With Sheets("sheet1")
    For i = 5 To 10
        k = 13
        For j = 8 To 16
            If .Cells(j, i).Interior.ColorIndex = xlNone Then
                Sheets("sheet2").Cells(k, i + 5) = a & .Cells(j, i)
                k = k + 1
            End If
        Next
    Next
    End With
End Sub

追问

Const t = 2
这个可不可以有4个

追答

要4个干嘛，几个x就等于几就可以了

追问

x位置不同
我可以在第1和第3和第4位置

追答

Sub xx()
    Const t1 = 1
    Const t2 = 0
    Const t3 = 3
    Const t4 = 0
    t = Array(t1, t2, t3, t4)
    With Sheets("sheet1")
    For i = 5 To 10
        k = 13
        For j = 8 To 16
            If .Cells(j, i).Interior.ColorIndex = xlNone Then
                a = .Cells(j, i)
                For n = 0 To 3
                  If t(n) = 1 Then
                    a = "X" & a
                  ElseIf t(n) > Len(a) Then
                    a = a & "X"
                  ElseIf t(n) > 0 Then
                    a = Left(a, t(n) - 1) & "X" & Mid(a, t(n))
                  End If
                Next
                Sheets("sheet2").Cells(k, i + 5) = a
                k = k + 1
            End If
        Next
    Next
    End With
End Sub

追问

Sheets("sheet2").Cells(k, i-4) = a 对象定义错误

追答

i-4是相对位置，同列为i，左-右+