Макрос, который работает, только если диапазон ячеек содержит 1

Question

У меня есть макрос, который отлично работает, но только если у диапазона есть 1 в первой ячейке, например: Range ("E1: E12").Если я хочу изменить диапазон на Range («E2: E13»), он не будет вставлен в правильную ячейку.Загруженный лист Excel является текущим макросом, который работает, но мне нужно изменить диапазон на другие ячейки.

 Sub Part()
    Dim SearchRange As Range, _
        DashPair    As Variant, _
        PairParts   As Variant, _
        SearchVal   As Variant, _
        FoundPos    As Variant, _
        NextCol     As Long

    Set SearchRange = Range("E1:E12")
    For Each DashPair In Range("B30, F30, J30")
        Err.Clear
        NextCol = 1
        If DashPair.Value <> "" Then
            PairParts = Split(DashPair, "-")
            If PairParts(1) = "15" Then
                SearchVal = DashPair.Offset(RowOffset:=1).Value

                On Error Resume Next
                 Set FoundPos = SearchRange.Find(SearchVal, LookAt:=xlWhole)
                If Not FoundPos Is Nothing Then
                    FoundPos = FoundPos.Row
                    ' find first empty column right of E
                    While SearchRange(FoundPos).Offset(ColumnOffset:=NextCol).Value <> ""
                        NextCol = NextCol + 1
                    Wend

                    PairParts(1) = PairParts(1) + 1
                    PairParts = Join(PairParts, "-")

                    With SearchRange(FoundPos).Offset(ColumnOffset:=NextCol)
                        .NumberFormat = "@"
                        .Value = "" & PairParts & ""
                    End With

                    DashPair.Resize(ColumnSize:=3).ClearContents
                End If
            End If  '15 found
        End If
    Next DashPair
End Sub

превосходное изображение

Answer 1

Немного исправил код: ваша проблема в следующем: FoundPos = FoundPos.Row, так как SearchRange (FoundPos) вернет индексную ячейку, а не ячейку в той же строке

, то есть E2: E15 => E2 - это строка 2, но SearchRange (2) - это E3

* Редактировать *

Изменен следующий протокол выбора пустой ячейки;предыдущий не работал должным образом

Sub Part()
    Dim ws As Worksheet: Set ws = ActiveSheet

    Dim Cell As Range, Target As Range, arr As Variant

    With ws
        Dim SearchRange As Range: Set SearchRange = .Range("E1:E12")
        For Each Cell In .Range("B30, F30, J30")
            If Cell <> "" Then
                arr = Split(Cell, "-")
                If UBound(arr) > 0 And arr(1) = "15" Then
                    On Error Resume Next
                        Set Target = SearchRange.Find(Cell.Offset(1, 0), LookAt:=xlWhole)
                    On Error GoTo 0

                    If Not Target Is Nothing Then
                        Do While Target <> ""
                            Set Target = Target.Offset(0, 1)
                        Loop
                        With Target
                            arr(1) = "16"
                            .NumberFormat = "@"
                            .value = Join(arr, "-")
                            Debug.Print Join(arr, "-")
                        End With
                        .Range(Cell, Cell.Offset(0, 2)).ClearContents
                    End If
                End If
            End If
        Next Cell
    End With
End Sub