Подсчет чисел после появления определенных букв в столбце (с VBA в Excel)

У меня есть данные, которые идут вниз по столбцу (A:A) (см. пример).
Единственными возможными значениями [в этом случае] являются: 1,2,3,4,5,s,f и p,o, a,b,c (которые в данном случае не нужны и могут быть удалены)

1-
2-
с
1
2
3
2
ж
с< br> f
1
с
4
5
3
4
2
с< br> f
1
2
3
4

Мне нужен код, который будет подсчитывать частоты чисел после появления определенных букв. В этом случае я хочу, чтобы код подсчитывал числа после S или F. Я выделил жирным шрифтом числа после S и курсивом числа после F. Два числа в начале можно игнорировать, поскольку им не предшествует буква.

Тогда мне понадобится 10 разных выходных переменных

После S: Частота 1:## Частота 2:## Частота 3:## Частота 4:## Частота 5:## После F: Частота 1:## Частота 2:## Частота 3:## Частота 4:## Частота 5:##

Я предполагаю, что .countif пригодится, хотя понятия не имею, как это сделать.


excel vba counting
person user3084100    schedule 19.12.2013    source источник
comment
Вы можете перебрать диапазон, используя For Each c in Range("A1:100") Создайте пару массивов из пяти элементов, чтобы вести подсчет чисел после каждой буквы.   -  person Tim Williams    schedule 20.12.2013
comment
@TimWilliams, как он узнает, что нужно считать число после буквы s, но остановиться после буквы f?   -  person user3084100    schedule 20.12.2013
comment
Вы бы использовали пару переменных, таких как isS и isF, чтобы отслеживать, на какой букве вы сейчас находитесь. Просто попробуйте записать, как бы вы это сделали, если бы считали вручную. Используйте в качестве основы для вашего кода.   -  person Tim Williams    schedule 20.12.2013

Ответы (3)


arrow_upward
0
arrow_downward

Это то, что вы ищите? Есть и другие способы добиться этого. Дайте мне знать, если у вас есть какие-либо вопросы о том, что я сделал.

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
person SCar88    schedule 19.12.2013
comment
Похоже, это не сработало :/ В приведенном мной примере sOne должно быть 1, а sTwo должно быть 3 (поскольку он считает все числа после буквы, а не только самое первое после буквы). - person user3084100; 20.12.2013
comment
Если это то, что вы искали, вы бы приняли этот ответ? - person SCar88; 24.12.2013

arrow_upward
0
arrow_downward

Для этого вам не нужен код VBA. Если ваши значения в столбце A состоят только из значений 1,2,3,4,5,s и f, вы можете использовать вспомогательный столбец, как показано на рисунке ниже.

Рабочий лист Excel

Формула в ячейке B2

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

и это копируется в оставшиеся ячейки столбца B. После того, как первый s или f встречается в A, B содержит либо s, либо f в зависимости от того, что произошло в «последнем».

Формулу для ячейки E4 можно увидеть на картинке, скопировав ее в диапазон E4:I5, вы получите таблицу результатов.

person DMM    schedule 20.12.2013

arrow_upward
0
arrow_downward

Вот довольно гибкий подход:

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
person Tim Williams    schedule 20.12.2013