复制数组中的值和颜色索引答案

【问题标题】：Copying Values and Color Index in an Array复制数组中的值和颜色索引
【发布时间】：2018-08-04 04:02:44
【问题描述】：

我有一个宏，它允许我根据文件名打开多个文件并根据条件复制工作表（如果“X”列中有值，则复制行但只复制一些列“F、G、P、 Q,W,X,Y) 到另一个独特的工作簿。问题出在 F 列中，我有颜色，我想检索颜色索引，但宏将其留空

 [1] Get data from A1:Z{n}

  n = ws.Range("A" & Rows.Count).End(xlUp).Row   ' find last row number n
  v = ws.Range("A10:Y" & n).Value2 ' get data cols A:Y and omit header row

 [2] build array containing found rows

  a = buildAr2(v, 24) ' search in column X = 24

' [3a] Row Filter based on criteria

  v = Application.Transpose(Application.Index(v, _
  a, _
Application.Evaluate("row(1:" & 26 & ")"))) ' all columns from A to Z

[3b] Column Filter F,G,P,Q,W,X,Y

  v = Application.Transpose(Application.Transpose(Application.Index(v, _
      Application.Evaluate("row(1:" & UBound(a) - LBound(a) + 1 & ")"), _
      Array(6, 7, 16, 17, 23, 24, 25))))          ' only cols F,G,P,Q,W,X,Y

Function buildAr2(v, ByVal vColumn&, Optional criteria) As Variant
' Purpose: Helper function to check in Column X
' Note:    called by main function MultiCriteria in section [2]
Dim found&, found2&, i&, j&, n&, ar: ReDim ar(0 To UBound(v) - 1)
howMany = 0      ' reset boolean value to default
  For i = LBound(v) To UBound(v)
    If Len(Trim(v(i, vColumn))) > 0 Then
       ar(n) = i
       n = n + 1
    End If
  Next i
  If n < 2 Then
     howMany = n: n = 2
  Else
     howMany = n
  End If
  ReDim Preserve ar(0 To n - 1)
  buildAr2 = ar
End Function

【问题讨论】：

“我想检索颜色索引，但宏将其留空” 我在您的代码中没有看到您尝试检索颜色索引的位置。请查看如何提供minimal reproducible example。
@Pᴇʜ 我只是在这里复制数组中的值，我不知道怎么说这个特定列复制颜色索引而不是它的值
请添加带有示例数据的minimal reproducible example 以供输入。
v = ws.Range("A10:Y" & n).Value2 此方法只会复制值。另一种方法是将整个数据复制到数组中，如果您有特定的单元格将具有颜色，那么您可以直接替换数组中的相关值。
源代码提示：稍微缩短的代码基于我对Multi criteria selection with VBA 的回答，我在其中评论说分配给（数据字段）数组的（范围）值不包含格式信息并引用明确向 MCVE。

标签： vba excel

【解决方案1】：

如何将过滤后的数组值与颜色格式一起复制（F 列）

您获得了使用Application.Index 属性行 AND 列过滤数据字段数组v 并将这些数据写入目标工作表的解决方案 - c.f. Multi criteria selection with VBA
您的问题是找到一种方法，不仅可以写入数据，还可以将列 F 的源颜色格式写入目标单元格，因为数组本身包含值且没有颜色信息.

将过滤后的信息写入定义好的STARTROW（例如10），然后可以使用数组a的项目编号加上标题偏移量headerIncrement）通过一个简单的循环重构源行号，以便得到/也写颜色格式：

代码添加

' [4a] Copy results array to target sheet, e.g. start row at A10
  Const STARTROW& = 10
  ws2.Cells(STARTROW, 1).Offset(0, 0).Resize(UBound(v), UBound(v, 2)) = v
' **************************************************************************
' [4b] Copy color formats using available item number information in array a
' **************************************************************************
  Dim sourceColumn&: sourceColumn = 6   ' <<~~ source column F = 6
  Dim targetColumn&: targetColumn = 1   ' <<~~ becomes first target column
  Dim headerIncrement&: headerIncrement = STARTROW - 1
  For i = 0 To UBound(a)
    ws2.Cells(i + headerIncrement, targetColumn).Offset(1, 26).Interior.Color = _
    ws.Cells(a(i) + headerIncrement, sourceColumn).Interior.Color
  Next i

旁注不要忘记设置Option Explicit 以强制声明变量并在代码模块的声明头中声明变量howMany（在两个过程中都使用）。

【讨论】：

谢谢@T.M 我只是做了一点修改，它按预期工作
Avec plaisir /不客气……最终我喜欢你对提问的坚持和热情，因为它让我想到了一个简单而清晰的结构化解决方案在当前代码的逻辑中。尽管如此，在 SO (Stack Overflow) 中指出您的自己的 编码工作或计划的逻辑步骤（伪代码）还是很有用的，以便其他读者了解您在哪里智慧结束:-)

【解决方案2】：

我不知道问题出在哪里，但你问：

问题出在 F 列中，我有颜色，我想检索颜色索引，但宏将其留空

这是从单元格 A1 中检索颜色索引的方法：

col = Range("A1").Interior.ColorIndex

我建议您尝试检索它，如果遇到问题：按照 Pᴇʜ 的建议，用您的示例打开一个问题。

【讨论】：

【解决方案3】：

除了@Pᴇʜ上面的cmets，事实上你主要处理的是v，一个variant数组strings，将是一个限制因素。如果您想要单元格的 .Interior.ColorIndex 属性（范围），您将不得不处理 Range。

此外，如果您想准确了解颜色，请使用 color 而不是 ColorIndex。
ColorIndex 将返回最接近的索引颜色。

【讨论】：