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

excel image

Answer 1

稍微清理一下代码：您的问题在于以下内容：FoundPos = FoundPos.Row as 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

仅当单元格区域中包含1的宏才起作用

1 个答案: