Question

我在一个文件夹中有多个excel，其中一些单元格中填充了黄色和红色

我需要一个excel日志，它会在每个与之对应的excel中生成黄色文件名计数

例如：

文件名黄色红色

1.xlsx 13 14 2.xlsx 5 10

任何人都可以帮助我。

Answer 1

这会将红色和黄色单元格记录在名为＆＃34; Log Sheet＆＃34;在您运行此代码的工作簿中。添加/命名此工作表以及您自己需要的任何格式。获取有条件格式化单元格的单元格颜色很棘手，但您可以在this article中找到帮助。我在日志表中包含了一个列，以确定工作表中是否存在条件格式化的单元格，但没有分析或计数。我还添加了一个包含工作表标签名称的列。

此代码分析表格中的单元格颜色。 UsedRange。您需要在变量dataFileFolder中输入数据文件的路径。

Log Sheet

Sub countYellowRedCells()
Dim wbk As Variant
Dim wsLog As Worksheet, sht As Worksheet
Dim cCell As Range
Dim cfFlag As Boolean
Dim dataFileFolder As String
Dim redCount As Long, yellowCount As Long
Dim logRowEnd As Long, logCol As Long

Set wsLog = ThisWorkbook.Sheets("Log Sheet")

logCol = 2
redCount = 0
yellowCount = 0
cfFlag = False

dataFileFolder = "C:\......TestFiles\" 'ENTER YOUR PATH

Application.ScreenUpdating = False

wbk = Dir(dataFileFolder)

    Do Until wbk = ""
        Workbooks.Open dataFileFolder & wbk
            For Each sht In ActiveWorkbook.Worksheets
                For Each cCell In sht.UsedRange
                    If cCell.FormatConditions.count <> 0 Then cfFlag = True
                    Select Case cCell.Interior.Color
                        Case Is = RGB(255, 0, 0)
                            redCount = redCount + 1
                        Case RGB(255, 255, 0)
                            yellowCount = yellowCount + 1
                    End Select
                Next cCell

                With wsLog
                    logRowEnd = .Cells(Rows.count, logCol).End(xlUp).Row
                    .Cells(logRowEnd, logCol).Offset(1, 0).Value = ActiveWorkbook.Name
                    .Cells(logRowEnd, logCol).Offset(1, 1).Value = sht.Name
                    .Cells(logRowEnd, logCol).Offset(1, 2).Value = yellowCount
                    .Cells(logRowEnd, logCol).Offset(1, 3).Value = redCount
                    .Cells(logRowEnd, logCol).Offset(1, 4).Value = cfFlag
                End With

                'MsgBox (ActiveWorkbook.Name & " - Sheet: " & sht.Name & Chr(10) _
                & redCount & " Red cells." & Chr(10) & yellowCount & " Yellow cells.")
                redCount = 0
                yellowCount = 0
                cfFlag = False
            Next sht
        Workbooks(wbk).Close savechanges:=False
        wbk = Dir
    Loop

Application.ScreenUpdating = True

End Sub

计算多个excel文件中的多种颜色vba

1 个答案: