怎么通过VBA代码，将B3:M10区域内的单元格颜色代码提取到E101:E196。

kaiqiang0215 · 发表于 2022-12-15 09:16

怎么通过VBA代码，将B3:M10区域内的单元格颜色代码提取到E101:E196。不要通过GET.CELL()公式。

chxw68 · 发表于 2022-12-15 09:26

Sub test()
Dim r%, i%
Dim arr(1 To 8 * 12, 1 To 1)
m = 0
With Worksheets("sheet1")
For j = 2 To 13
For i = 3 To 10
m = m + 1
arr(m, 1) = .Cells(i, j).Interior.Color
Next
Next
.Range("e101").Resize(UBound(arr), 1) = arr
End With
End Sub

复制代码

chxw68 · 发表于 2022-12-15 09:26

详见附件。

grf1973 · 发表于 2022-12-15 09:47

用字典取得单元格的颜色，还原即可。

kaiqiang0215 · 发表于 2022-12-15 11:00

grf1973 发表于 2022-12-15 09:47
用字典取得单元格的颜色，还原即可。

不好意思，可能我表达的不太清楚，我想要的效果是，如果B3:M10区域有颜色，那么E101:E196显示的是字符，而不是颜色，如果单元格有颜色，那么就显示1，如果没有颜色就显示0.

grf1973 · 发表于 2022-12-15 11:38

稍微改一下即可

你地铁图 · 发表于 2022-12-15 13:13

for each 循环就好了

你地铁图 · 发表于 2022-12-15 13:13

for each 循环就好了

你地铁图 · 发表于 2022-12-15 13:14

Sub ys()
Dim r As Range, r1 As Range
For Each r In Range("B3:M10")
      For Each r1 In Range("b101:b196")
         If Left(r.Value, 4) = Right(r1.Value, 4) And r.Interior.Color <> 16777215 Then
            r1.Offset(, 3).Value = 1
         ElseIf Left(r.Value, 4) = Right(r1.Value, 4) And r.Interior.Color = 16777215 Then
            r1.Offset(, 3).Value = 0
         End If
      Next
Next
End Sub

你地铁图 · 发表于 2022-12-15 13:18

for each 循环就好了

		自动登录	找回密码
密码			免费注册

[求助] 怎么通过VBA代码，将B3:M10区域内的单元格颜色代码提取到E101:E196。