通过button返回有条件格式化的连续数据

需要VBA使用ECR所在的“位置”返回ECR> 30天。当您按下easybutton时。 程序需要扫描红色单元格并创build一个数组，并将数组放入另一个工作簿。

目前代码：

Sub easy_button_2() Dim rw As Long, c As Long, fast As String, X fast = "Y" With Workbooks("ECR Log w_fast.xlsm").Sheets("Sheet 3") With Workbooks("ECR Log w_fast.xlsm").Sheets("Sheet 2") 'clear any previous ECR #s/Location results rw = Application.Match("ECR #s", .Range(.Cells(3, 1), .Cells(Rows.Count, 1).End(xlUp)), 0) With .Range(.Cells(rw + 24, 1), .Cells(Rows.Count, 1).End(xlUp)) .Resize(.Rows.Count, 2).Offset(1, 0).ClearContents End With 'reset the Locations named range With .Range(.Cells(3, 1), .Cells(3, 1).End(xlDown)) .Resize(.Rows.Count, .Cells(1, Columns.Count).End(xlToLeft).Column).Name = "Locations" End With 'cycle through the ECRs in Locations' column 1 With .Range("Locations") For rw = 2 To .Rows.Count If .Cells(rw, 3) > 30 Or .Cells(rw, 2) = fast Then For c = 3 To .Columns.Count If .Cells(rw, c).DisplayFormat.Interior.Color = vbRed Then .Parent.Cells(Rows.Count, 1).End(xlUp).Resize(1, 2).Offset(1, 0) = _ Array(.Cells(rw, 1).Value2, .Cells(1, c).Value2) Exit For End If Next c End If Next rw End With End With End With 

'Workbooks.Open Filename：=“C：\ Users \ MJ \ Desktop \ ECR Monitor.xlsm”'ThisWorkbook.Activate End Sub

Answer 1

有两种不同的方法可直接从观察的单元格颜色确定条件格式设置规则的状态。 您可以使用AutoFilter方法 ，或者使用Range.DisplayFormat属性来检查.Interior.ColorIndex（您正在筛选3 ，而不是255 ）。

^{看来， 地点范围可以扩大到第七排。 要将其定位到dynamic更新的范围，定义的名称位置将根据从A3展开的单元重新定义。}

方法1：自动筛选方法

 Sub easy_button_1() Dim rw As Long, c As Long, vr As Range Application.ScreenUpdating = False With Worksheets("sheet2") If .AutoFilterMode Then .AutoFilterMode = False 'clear any previous ECR #s/Location results rw = Application.Match("ECR #s", .Range(.Cells(4, 1), .Cells(Rows.Count, 1).End(xlUp)), 0) With .Range(.Cells(rw + 3, 1), .Cells(Rows.Count, 1).End(xlUp)) .Resize(.Rows.Count, 2).Offset(1, 0).ClearContents End With 'reset the Locations named range With .Range(.Cells(3, 1), .Cells(3, 1).End(xlDown)) .Resize(.Rows.Count, .Cells(1, Columns.Count).End(xlToLeft).Column).Name = "Locations" End With 'AutoFilter the Locations named range With .Range("Locations") .AutoFilter Field:=2, Criteria1:=">30" For c = 3 To .Columns.Count '.AutoFilter Field:=c, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor .AutoFilter Field:=c, Criteria1:=vbRed, Operator:=xlFilterCellColor If c > 3 Then .AutoFilter Field:=c - 1, Criteria1:=vbGreen, Operator:=xlFilterCellColor '.AutoFilter Field:=c - 1, Criteria1:=RGB(0, 255, 0), Operator:=xlFilterCellColor End If With .Resize(.Rows.Count - 1, 1).Offset(1, 0) 'only attempt to transfer values if there is something visible If CBool(Application.Subtotal(103, .Cells)) Then For Each vr In .SpecialCells(xlCellTypeVisible) 'cycle through the visible rows .Parent.Cells(Rows.Count, 1).End(xlUp).Resize(1, 2).Offset(1, 0) = _ Array(vr.Value2, .Cells(0, c).Value2) Next vr End If End With If c > 3 Then .AutoFilter Field:=c - 1 .AutoFilter Field:=c Next c .AutoFilter Field:=2 End With If .AutoFilterMode Then .AutoFilterMode = False End With Application.ScreenUpdating = True End Sub 

通过重复的F8水龙头步骤通过上述过程来观察过程中的工作。

方法2：Range.DisplayFormat属性

 Sub easy_button_2() Dim rw As Long, c As Long With Worksheets("sheet2") 'clear any previous ECR #s/Location results rw = Application.Match("ECR #s", .Range(.Cells(4, 1), .Cells(Rows.Count, 1).End(xlUp)), 0) With .Range(.Cells(rw + 3, 1), .Cells(Rows.Count, 1).End(xlUp)) .Resize(.Rows.Count, 2).Offset(1, 0).ClearContents End With 'reset the Locations named range With .Range(.Cells(3, 1), .Cells(3, 1).End(xlDown)) .Resize(.Rows.Count, .Cells(1, Columns.Count).End(xlToLeft).Column).Name = "Locations" End With 'cycle through the ECRs in Locations' column 1 With .Range("Locations") For rw = 2 To .Rows.Count If .Cells(rw, 2) > 30 Then For c = 3 To .Columns.Count If .Cells(rw, c).DisplayFormat.Interior.Color = vbRed Then .Parent.Cells(Rows.Count, 1).End(xlUp).Resize(1, 2).Offset(1, 0) = _ Array(.Cells(rw, 1).Value2, .Cells(1, c).Value2) Exit For End If Next c End If Next rw End With End With End Sub 

通过重复的F8水龙头步骤通过上述过程来观察过程中的工作。 在循环访问命名区域时，请注意rw和c的值会发生变化。

^{请注意，上述两者都依赖于vbRed和vbGreen的数字颜色代码常量。 如果您使用的色彩与主要RGB（255,0,0）和RGB（0,255,0）不同，则必须进行调整。}

^{按颜色过滤}

Answer 2

如果我想将此程序运行的值返回到另一个工作表或其他工作簿，该怎么办？ 我可以在另一个工作簿中引用数组吗？ 也许声明数组作为引用它的variables？

或者我必须将数组放在另一个工作表中并引用另一个工作簿？

 Sub easy_button_2() Dim rw As Long, c As Long, fast As String fast = "Y" Dim ws3 As Worksheet Set ws3 = Workbooks("ECR Log w_fast.xlsm").Sheets("Sheet 3") With Workbooks("ECR Log w_fast.xlsm").Sheets("Sheet 2") 'clear any previous ECR #s/Location results rw = Application.Match("ECR #s", .Range(.Cells(3, 1), .Cells(Rows.Count, 1).End(xlUp)), 0) With .Range(.Cells(rw + 100, 1), .Cells(Rows.Count, 1).End(xlUp)) .Resize(.Rows.Count, 2).Offset(1, 0).ClearContents End With 'reset the Locations named range With .Range(.Cells(3, 1), .Cells(3, 1).End(xlDown)) .Resize(.Rows.Count, .Cells(1, Columns.Count).End(xlToLeft).Column).Name = "Locations" End With 'cycle through the ECRs in Locations' column 1 With .Range("Locations") For rw = 2 To .Rows.Count If .Cells(rw, 3) > 30 Or .Cells(rw, 2) = fast Then For c = 3 To .Columns.Count If .Cells(rw, c).DisplayFormat.Interior.Color = vbRed Then ws3.Cells(Rows.Count, 1).End(xlUp).Resize(1, 2).Offset(1, 0) = _ Array(.Cells(rw, 1).Value2, .Cells(1, c).Value2) Exit For End If Next c End If Next rw End With End With 

结束小组