идентифицировать ряд ячеек в строке с похожим форматом и извлечь его

Question

Я новичок в VBA и застрял в конкретной проблеме.У меня есть испорченная таблица, из которой мне нужно извлечь последовательность ячеек (выделено красным на изображении).Он появляется в таблице случайным образом, однако всегда в той же последовательности и формате (дата> Число> Число> Число> Символ).Мне нужно извлечь все эти последовательности и сопоставить их в конце таблицы, как показано на рисунке2.Буду признателен за помощь в получении кода, так как я новичок в VBA и не могу сделать то же самое.логика, которая, я думаю, может помочь решить эти проблемы 1) Цикл по строкам 2) соответствие формату 3) извлечение значений, если они совпадают, любая другая логика, кроме проверки непрерывного формата, также может быть рассмотрена.это то, что я мог бы придумать

Новый для VBA.Получил кодовую логику, как указано

Как показано на изображении

Answer 1

В моем коде предполагается, что ячейки Date, Number, Number, Number, Text всегда будут находиться в одной строке друг с другом (хотя они могут присутствовать в любом месте этой строки).

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

При необходимости измените значение OUTPUT_SHEET_NAME.

Option Explicit

Sub CollateValues()

    Const OUTPUT_SHEET_NAME As String = "Sheet2" ' Change this as needed.

    Dim outputSheet As Worksheet
    Set outputSheet = ThisWorkbook.Worksheets(OUTPUT_SHEET_NAME)

    ' Write hardcoded list of headers to output sheet
    outputSheet.Range("A1").Resize(1, 5) = Array("Date", "Outstanding", "Overdue", "NPI", "Status")

    Dim outputRowIndex As Long
    outputRowIndex = 1 ' Skip headers

    Dim inputSheet As Worksheet ' Used to loop over worksheets

    For Each inputSheet In ThisWorkbook.Worksheets
        If inputSheet.Name <> OUTPUT_SHEET_NAME Then
            With inputSheet

                Dim numericCellsFound As Range
                On Error Resume Next
                Set numericCellsFound = .Cells.SpecialCells(xlCellTypeConstants, xlNumbers) ' Suppress error if no cells were found
                On Error GoTo 0

                If Not (numericCellsFound Is Nothing) Then ' Check if any cells were found on previous lines
                    Dim cell As Range
                    Dim numericCell As Range

                    ' Dates are basically numbers, so loop through all numeric cells.
                    For Each numericCell In numericCellsFound
                        If IsDate(numericCell) Then ' Check if the cell we're currently looping through is a date
                            If Application.Count(numericCell.Offset(0, 1).Resize(1, 3)) = 3 Then ' Check if the next three cells to the right of the date are all numbers. We use the worksheet function COUNT, which you may be familiar with.
                                If Application.IsText(numericCell.Offset(0, 4)) Then ' Check if the fourth cell to the right of the date is text/characters. The worksheet function ISTEXT is used.
                                    outputRowIndex = outputRowIndex + 1 ' We want to write to the next line, so increment this variable by 1.
                                    numericCell.Resize(1, 5).Copy outputSheet.Cells(outputRowIndex, "A") ' Copy-paste the 5 cells (Date, Number, Number, Number, Text), which have passed all the checks on the previous lines, to the next row on the output worksheet.
                                End If
                            End If
                        End If
                    Next numericCell

                    Set numericCellsFound = Nothing ' Reset this, otherwise the current iteration's results can be affected by a previous iteration.
                End If
            End With
        End If
    Next inputSheet
End Sub

Answer 2

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

Sub example() Dim clm, rw, clm2, rw2, i As Long rw2=1 '1. loop trough used range rows and columns For clm = 1 To ActiveSheet.UsedRange.Columns.Count For rw = 1 To ActiveSheet.UsedRange.Rows.Count 'validate if current cell value is date If IsDate(Cells(rw, clm)) = True Then 'validate if current cell value is numeric If IsNumeric(Cells(rw, clm + 1)) = True Then 'add another sheet to store the values ' five subsequent columns same cell cells clm2 =1<br> For i = 0 To 5 ActiveWorkbook.Sheets("AnotherSheet").Cells(rw2, clm2).Value = ActiveSheet.Cells(rw, clm + i) Next i rw2=rw2+1 End If End If Next rw Next clm End Sub