Counting numbers after certain letters have occured down a column (with VBA in excel)

StackOverflow https://stackoverflow.com/questions/20690309

  •  19-09-2022
  •  | 
  •  

Pergunta

I have data which goes down a column (A:A) (see example).
The only possible values [in this case] are: 1,2,3,4,5,s,f and p,o,a,b,c, (which aren't needed in this case and can be deleted)

1-
2-
s
1
2
3
2

f
s
f
1
s
4
5
3
4
2

s
f
1
2
3
4

I need some code that will count the frequencies of numbers after certain letters have occured. In this case, i want the code to count the numbers after S or F. I have put in bold the numbers after S and in italics the numbers after F. The two numbers at the start can be ignored since no letter precedes them.

I would then need 10 different output variables

After S: Frequency of 1:## Frequency of 2:## Frequency of 3:## Frequency of 4:## Frequency of 5:## After F: Frequency of 1:## Frequency of 2:## Frequency of 3:## Frequency of 4:## Frequency of 5:##

Im assuming the .countif would come in handy, have no idea to make this work though.

Foi útil?

Solução

Is this what you are looking for? There are other ways to accomplish this as well. Let me know if you have any questions about what I did.

Private Sub CommandButton1_Click()
Dim sOne As Integer
Dim sTwo As Integer
Dim sThree As Integer
Dim sFour As Integer
Dim sFive As Integer
Dim fOne As Integer
Dim fTwo As Integer
Dim fThree As Integer
Dim fFour As Integer
Dim fFive As Integer

Dim lastRow As Integer

lastRow = ThisWorkbook.Sheets(1).Range("A1").End(xlDown).Row

For rows1 = 1 To lastRow

If ThisWorkbook.Sheets(1).Range("A" & rows1) = "s" Then

    Do While WorksheetFunction.IsNumber(ThisWorkbook.Sheets(1).Range("A" & rows1 + 1))
        If ThisWorkbook.Sheets(1).Range("A" & rows1 + 1) = 1 Then
            sOne = sOne + 1
        ElseIf ThisWorkbook.Sheets(1).Range("A" & rows1 + 1) = 2 Then
            sTwo = sTwo + 1
        ElseIf ThisWorkbook.Sheets(1).Range("A" & rows1 + 1) = 3 Then
            sThree = sThree + 1
        ElseIf ThisWorkbook.Sheets(1).Range("A" & rows1 + 1) = 4 Then
            sFour = sFour + 1
        ElseIf ThisWorkbook.Sheets(1).Range("A" & rows1 + 1) = 5 Then
            sFive = sFive + 1
        End If

        rows1 = rows1 + 1
    Loop

ElseIf ThisWorkbook.Sheets(1).Range("A" & rows1) = "f" Then

    Do While WorksheetFunction.IsNumber(ThisWorkbook.Sheets(1).Range("A" & rows1 + 1))
        If ThisWorkbook.Sheets(1).Range("A" & rows1 + 1) = 1 Then
            fOne = fOne + 1
        ElseIf ThisWorkbook.Sheets(1).Range("A" & rows1 + 1) = 2 Then
            fTwo = fTwo + 1
        ElseIf ThisWorkbook.Sheets(1).Range("A" & rows1 + 1) = 3 Then
            fThree = fThree + 1
        ElseIf ThisWorkbook.Sheets(1).Range("A" & rows1 + 1) = 4 Then
            fFour = fFour + 1
        ElseIf ThisWorkbook.Sheets(1).Range("A" & rows1 + 1) = 5 Then
            fFive = fFive + 1
        End If

        rows1 = rows1 + 1
    Loop

End If

Next rows1

ThisWorkbook.Sheets(1).Range("H2") = sOne
ThisWorkbook.Sheets(1).Range("H3") = sTwo
ThisWorkbook.Sheets(1).Range("H4") = sThree
ThisWorkbook.Sheets(1).Range("H5") = sFour
ThisWorkbook.Sheets(1).Range("H6") = sFive

ThisWorkbook.Sheets(1).Range("J2") = fOne
ThisWorkbook.Sheets(1).Range("J3") = fTwo
ThisWorkbook.Sheets(1).Range("J4") = fThree
ThisWorkbook.Sheets(1).Range("J5") = fFour
ThisWorkbook.Sheets(1).Range("J6") = fFive


End Sub

Outras dicas

You don't need VBA code to do this. If your values in column A only consist of the values 1,2,3,4,5,s and f then you can use a helper column as shown in the picture, below.

Excel worksheet

The formula in cell B2 is

=IF(ISNUMBER(A2),B1,A2)

and this is copied down the remaining cells of column B. After the first s or f is encountered in A, B contains either s or f dependent on which occurred in 'most recently'.

The formula for cell E4 can be seen from the picture and copying this to range E4:I5 provides your results table.

Here's a fairly flexible approach:

Sub Tester()
Dim d As Object, x As Long, k
Dim arrL, arr, L As String, c As Range, tmp

    arrL = Array("s", "f")
    Set d = CreateObject("scripting.dictionary")
    For x = LBound(arrL) To UBound(arrL)
        d.Add arrL(x), Array(0, 0, 0, 0, 0)
    Next x

    Set c = ActiveSheet.Range("A1")
    L = ""
    Do While Len(c.Value) > 0
        tmp = c.Value
        If d.exists(tmp) Then
            L = tmp 'save the "current" letter
        Else
            If IsNumeric(tmp) Then
                'assuming whole numbers...
                If tmp >= 1 And tmp <= 5 Then
                    If d.exists(L) Then
                       'can't modify an array stored in a dictionary: copy out
                       arr = d(L)
                       arr(tmp - 1) = arr(tmp - 1) + 1
                       d(L) = arr 'store back in dict
                    End If
                End If
            End If
        End If

        Set c = c.Offset(1, 0)
    Loop

    'output the letters and counts
    For Each k In d.keys
        Debug.Print k, Join(d(k), ", ")
    Next k


End Sub
Licenciado em: CC-BY-SA com atribuição
Não afiliado a StackOverflow
scroll top