Я пытаюсь создать программу для общего количества ячеек, содержащих зеленый и красный шрифт в столбце А, среди всех листов рабочей книги.

В приведенном ниже коде он подсчитывает ВСЕ ячейки, содержащие зеленый и красный шрифт в столбце А листов.

Пожалуйста, не забудьте оставить комментарий, если вы можете направить меня в правильном направлении!

Я также составил пример листа Google о том, что я пытаюсь сделать:

' If it's not going to return something, you can define this as a procedure (sub) and not a function
Sub Test_It()

    Dim mySheet As Worksheet ' Define as worksheet if you're going to loop through sheets and none is a Graph/Chart sheet

    Dim printRow As Integer ' Beware that integer it's limited to 32k rows (if you need more, use Long)
    printRow = 2


    For Each mySheet In ThisWorkbook.Sheets ' use the mySheet object previously defined

        Range("N" & printRow).Value = "Sheet Name:"
        Range("O" & printRow).Value = mySheet.Name
        Range("P" & printRow).Value = "Approval:"
        Range("Q" & printRow).Value = SumGreen(mySheet) ' you can pass the sheet as an object
        Range("R" & printRow).Value = "Refused:"
        Range("S" & printRow).Value = SumRed(mySheet)
        printRow = printRow + 1
    Next mySheet

End Sub

-------------------------------------------

Function SumGreen(mySheet As Worksheet) As Long ' define the type the function is going to return

    Dim myCell As Range

    Dim counter As Long

    For Each myCell In mySheet.UsedRange.Columns("A") ' UsedRange is the range that has information

        If myCell.Font.Color = RGB(112, 173, 71) Then ' 255 is red, not green, change to whatever you need

            counter = counter + 1 ' change to counter + mycell.value if you have values and you want to sum them

        End If

    Next myCell

    ' Set the function to return the counter
    SumGreen = counter

End Function

-------------------------------------------


Function SumRed(mySheet As Worksheet) As Long ' define the type the function is going to return

    Dim myCell As Range

    Dim counter As Long

    For Each myCell In mySheet.UsedRange.Columns("A") ' UsedRange is the range that has information

        If myCell.Font.Color = 255 Then ' 255 is red, not green, change to whatever you need

            counter = counter + 1 ' change to counter + mycell.value if you have values and you want to sum them

        End If

    Next myCell

    ' Set the function to return the counter
    SumRed = counter

End Function

0
Chris 14 Апр 2019 в 17:06

2 ответа

Лучший ответ

Вам нужно перебирать ячейки, а не диапазон:

Function SumGreen(mySheet As Worksheet) As Long

    Dim rng As Range
    Set rng = mySheet.UsedRange.Columns("A")
    Dim cel As Range
    Dim counter As Long

    For Each cel In rng.Cells 'add .Cells here and it works like a charm
        If myCell.Font.Color = RGB(0, 255, 0) Then
           counter = counter + 1
        End If
    Next myCell

    SumGreen = counter

End Function
0
Cubius 14 Апр 2019 в 15:21

Ваш зеленый цвет не RGB (112, 173, 71), попробуйте

Sub Test_It()

    Dim mySheet As Worksheet 
    Dim printRow As Integer
    printRow = 2
    For Each mySheet In ThisWorkbook.Sheets
        Range("A" & printRow).Value = mySheet.Name
        Range("B" & printRow).Value = SumGreen(mySheet)
        Range("C" & printRow).Value = SumRed(mySheet)
        printRow = printRow + 1
    Next mySheet
End Sub
Function SumGreen(mySheet As Worksheet) As Long 
    Dim myCell As Range
    Dim counter As Long
    For Each myCell In mySheet.UsedRange.Columns(1).Cells ' <<<< changed
        If myCell.Font.Color = 65280 Then
            counter = counter + 1
        End If
    Next myCell
    ' Set the function to return the counter
    SumGreen = counter
End Function

Function SumRed(mySheet As Worksheet) As Long
    Dim myCell As Range
    Dim counter As Long
    For Each myCell In mySheet.UsedRange.Columns(1).Cells
        If myCell.Font.Color = 255 Then ' 255 is red
            counter = counter + 1 
        End If
    Next myCell
    ' Set the function to return the counter
    SumRed = counter
End Function
0
patel 15 Апр 2019 в 07:28