☰

範囲が A1 または T1 などのセルで始まる場合にのみ機能するマクロを変更します。

tag-icon • tag-icon vba range
範囲が A1 または T1 などのセルで始まる場合にのみ機能するマクロを変更します。

動作するマクロがありますが、セル範囲を変更したいのですが

Set SearchRange = Range("E1:E12") to  
Set SearchRange = Range("A21:A32")

コードを変更しましたが、実行しても機能せず、何が問題なのかわかりません。コードの下に説明があります。

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

    Set SearchRange = Range("A21:A32")
    For Each DashPair In Range("B17, F17, J17")
        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 の例を参照してください。マクロは現在、セル B17、F17、J17 でのみ 15 (最後の数字 20-15 など) を検索します。結果が正の場合、その下のセルを参照し、その数字を使用してセル A21:A32 で一致するものを検索し、その右側の隣接セルにコピーして貼り付けます。

  • 例: セル B30 には 20-15 があり、その下のセル B18 には 1 があります。1 は範囲 A21:A32 の検索番号です。A21:A32 の範囲で見つかったら、20-15 を右隣のセル (B21) に配置し、最後の数字を 1 増やして 20-16 にします。

  • すべてのセル（B17、F17、J17）に対して同じことを行います。

  • 書き込み後、セル B17/C17/D17 のすべての内容が削除されます。Excel シートには、同じことが発生する例が 2 つあります。

エクセルシート

答え1

コードの問題は にあります。これは、範囲が行 1 から始まるSearchRange(FoundPos)場合にのみ、このアプリケーションで機能します。SearchRange

範囲を に変更するとA21:A32、FindPos 変数は21最初のケースになります。
これにより、SearchRange(FoundPos)範囲の 21 番目の行、つまり が返されますA41。

これを修正する方法はたくさんありますが、コードの変更を最小限に抑えるには、SearchRange(FoundPos)を に置き換えてみてくださいActiveSheet.Cells(FoundPos, SearchRange.Column)。

関連情報