Question

我有一个宏，它允许我根据文件名打开多个文件，并根据条件复制工作表（如果“ 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

Answer 1

除了@Pᴇʜ的上述评论外，您还主要在处理v，这是由 strings < / strong>，这将是一个限制因素。如果要使用单元格的.Interior.ColorIndex属性（范围），则必须处理 Range 。

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

Answer 2

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

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

这是从单元格A1检索colorindex的方法：

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

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

Answer 3

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

您找到了使用v属性通过行AND列 过滤数据字段Array Application.Index并将这些数据写入到目标表-cf 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（在两个过程中都使用）代码模块。

在数组中复制值和颜色索引

3 个答案: