|
- Sub TEST()
- Dim Arr, R&, C&
- Application.ScreenUpdating = False
- With [W:AP]: .ClearContents: .Interior.ColorIndex = xlNone: End With
- Arr = Range([U1], Cells(Rows.Count, 1).End(xlUp))
- R = UBound(Arr): C = UBound(Arr, 2)
- For j = 1 To C - 1
- For i = 1 To R
- Arr(i, j) = ""
- If Cells(i, j).Interior.ColorIndex = xlNone Then GoTo 101
- Arr(i, j) = Arr(i, C)
- [V1].Cells(i, j).Interior.ColorIndex = [U1].Cells(i, 1).Interior.ColorIndex
- 101: Next i
- Next j
- [V1].Resize(R, C - 1) = Arr
- End Sub
复制代码
Xl0000293.rar
(37.58 KB, 下载次数: 1)
|
|