Как посчитать пару текстов в одном столбце с разницей в несколько строк с помощью vba?

Question

В книге A я пытаюсь подсчитать, когда текст «Dr» появляется в 5-ти строках после него, сколько ячеек пустое или ячейка представляет собой текст «Nr» или «Cr».Другими словами, я пытаюсь подсчитать количество пар «DR-blank (в пределах 5 строк после DR)», «DR-NF (в пределах 5 строк после DR)» и «DR-CR (в пределах 5 строк).после ДР) ».Набор данных выглядит следующим образом:

Столбец A 0 1 2 3 4 5 6 7 8
Столбец B Dr Cr Dr Nr

И затем я хочу скопировать результат в рабочую книгу B.

Я пытался использовать смещение:

If Range("B2:B901").Value = "D" Then
      'V3 = Application.WorksheetFunction.CountBlank(.Range("B2:B901").Offset(5, 0))

       Wb.Worksheets("Sheet1").Cells(Rows.Count, "M").End(xlUp).Offset(1, 0).Value = V3

Но я всегда получал взамен "0", то есть логика была не совсем правильной, чтобы захватить то, что я намеревалсяделать.Может ли кто-нибудь помочь с кодами?Очень ценю!

Answer 1

Этот код будет перебирать каждую ячейку в указанном вами диапазоне (в данном случае B1:B901 в sheet1), и если он содержит значение Dr, он будет затем перебирать последующие 5 ячеек, чтобы проверить, содержат ли ониценности, которые вы ищете.

Он выведет содержимое column A и column B в новую рабочую книгу вместе с вашими счетами nr, cr и blank в столбцах c, d иe соответственно.

    Option Compare Text 'this tells VBA that you want you string comparisons to NOT be
                        'case sesitive. If you want case to be taken into account, then leave 
                        'this line out.

Sub test()

Dim cll As Range
Dim vCellValue As Variant
Dim iterator As Integer
Dim vCountBlank As Integer
Dim vCountCr As Integer
Dim vCountNr As Integer
Dim wb2 As Workbook




Set wb2 = Workbooks.Add

    For Each cll In Sheet1.Range("B2:B901")

        vCountBlank = 0
        vCountCr = 0
        vCountNr = 0


        If cll.Value = "Dr" Then

            For iterator = 1 To 5

                vCellValue = cll.Offset(iterator, 0).Value
                If vCellValue = "Nr" Then vCountNr = vCountNr + 1
                If vCellValue = "Cr" Then vCountCr = vCountCr + 1
                If vCellValue = "" Then vCountBlank = vCountBlank + 1

            Next iterator

        End If

        wb2.Sheets(1).Cells(cll.Row, 1).Value = cll.Offset(0, -1).Value
        wb2.Sheets(1).Cells(cll.Row, 2).Value = cll.Value
        wb2.Sheets(1).Cells(cll.Row, 3).Value = vCountNr
        wb2.Sheets(1).Cells(cll.Row, 4).Value = vCountCr
        wb2.Sheets(1).Cells(cll.Row, 5).Value = vCountBlank


    Next cll


Set wb2 = Nothing

End Sub