0

シートで特定の値（この場合は「ALAE」）を検索しようとしています。このインスタンスを見つけたら、下に移動して、後続のすべてのフィールドを別のワークシートにある参照値に置き換える必要があります。

たとえば、フィールドの列見出しに「ALAE」があり、その下に2つの「2」があります。リファレンスシートに移動し、2の意味を調べて、値をテキストバージョンに置き換える必要があります。「ALAE」の場所は常に変更され、見出しの下のフィールドの数も変更されます。マクロを実行するたびにこれを動的に行う必要があります。

現在、コードは最初の「2」を置き換えますが、2番目は置き換えません。

これが私がこれまでに持っているコードです

Sub Reference()

Dim macroSheet As Worksheet
Dim LastRow As Long
Dim strSearch As String
Dim aCell As Range, bCell As Range
Dim x As Integer

Set macroSheet = Sheets("Treaty Year Preview")
With macroSheet
     LastRow = .Range("A" & Rows.Count).End(xlUp).Row
     strSearch = "ALAE"
     Set aCell = .Range("A1:R" & LastRow).Find(What:=strSearch, LookIn:=xlValues, _
                                                        Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                                        MatchCase:=True, SearchFormat:=False)
     If Not aCell Is Nothing Then
        x = 1
        Set bCell = aCell
         Do
            aCell.Offset(x) = Application.WorksheetFunction.VLookup(aCell.Offset(x), Worksheets("ALAE ULAE").Range("A:B"), 2)
            x = x + 1

        Loop Until aCell.Offset(x) Is Nothing

    End If 'If Not aCell is Nothing Then
End With 'With macroSheet
End Sub
4

1 に答える 1

0

このコードを試してください。あなたが望むものをよりシンプルな方法で提供すると思います。私はあなたの投稿で読んだ内容に基づいて最善を尽くしましたが、不足しているものや間違っているものがある場合は、コメントしてください。必要に応じて調整します.

私の変更を説明するために、コードには多くのコメントが付けられています。:)

Sub Reference() 'given your post explanation and what I see, there is no need to pass a variable into the sub

    Dim macroSheet As Worksheet
    Dim lastRow As Long
    Dim strSearch As String
    Dim aCell As Range, bCell as Range
    ' the rest of the variables I removed because they were superfolous (yuck - bad spelling, i know!)


    Set macroSheet = Sheets("Treaty Year Preview")

    With macroSheet 'now we are working with the macroSheet, no need to reference it any more

        lastRow = .Range("A" & Rows.Count).End(xlUp).Row

        strSearch = "ALAE"

        Set aCell = .Range("A1:A" & lastRow).Find(What:=strSearch, LookIn:=xlValues, _
                                                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                                            MatchCase:=True, SearchFormat:=False)

        If Not aCell Is Nothing Then

            Set bCell = aCell

            Do

                'basically find the value 1 below the found cell and replace it with the value in the lookup table
                'I wasn't sure how your ALAE lookup table is organized, but you may need to change the ALAE!B:C reference to fit your needs.
                'i changed to vlookup because I am more familiar with that than lookup function
                aCell.Offset(1) = .Application.WorksheetFunction.VLookup(aCell.Offset(1), "ALAE!B:C", 2, False)

                'reset aCell to find the next one
                Set aCell = .Range("A1:A" & lastRow).Find(What:=strSearch, After:=aCell, LookIn:=xlValues, _
                                                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                                            MatchCase:=True, SearchFormat:=False)

            Loop Until aCell Is Nothing or aCell.Address = bCell.Address 'it will keep looping unless aCell returns nothing

        End If 'If Not aCell is Nothing Then

    End With 'With macroSheet

End Sub
于 2012-08-17T13:54:37.797 に答える