2

正しい人たち、私はもう少し助けを求めてまた戻ってきました。以前とまったく同じ構造の情報を含む新しいワークシートを毎月追加するワークブックがあります。列 A には請求書番号があり、次に列 B:J の詳細があります。列 K と L には、すべての未解決の問題に対して手動で追加されたコメントがあります。私がやりたいことは、最後のワークシートに対して請求書を検索し、列 K & L のコメントを新しいワークシートにコピーできるようにすることです。

少しコードを作成しようとしましたが、何もうまくいきません。ActiveSheet は、コメントなしで新しく作成されたものです。したがって、列 A の請求書番号を検索し、一致が見つかった列 K & L を最後のワークシートからアクティブシートの列 K & L にコピーしたいと考えています。私が意味をなすことを願っています。助けてくれてありがとう

Option Explicit

Sub FindCopy_all()

    Dim calc As Long
    Dim Cel As Range
    Dim LastRow As Long
    Dim rFound As Range
    Dim LookRange As Range
    Dim CelValue As Variant

     ' Speed
    calc = Application.Calculation
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

     'Get Last row of data ActiveSheet, Col A
    LastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row

     ' Set range to look in
    Set LookRange = ActiveSheet.Range("A1:A" & LastRow)

     ' Loop on each value (cell)
    For Each Cel In LookRange
         ' Get value to find
        CelValue = Cel.Value
         ' Look on previous sheet
        With Sheets(Sheets.Count - 3)

            Set rFound = .Cells.Find(What:=CelValue, _
            After:=.Cells(1, 1), LookIn:=xlValues, _
            Lookat:=xlWhole, MatchCase:=False)

             ' Reset
            On Error GoTo endo

             ' Not found, go next
            If rFound Is Nothing Then
                GoTo NextCel
            Else
                 ' Found. last sheet, Col K & L to Active Sheet found Row, Col K & L
                .Cells(rFound.Row, 11, 12).Resize(, 2).Copy ActiveSheet.Cells(Cel.Row, 11, 12)
            End If
        End With
NextCel:
    Next Cel
Set rFound = Nothing

     'Reset

endo:

    With Application
        .Calculation = calc
        .ScreenUpdating = True
    End With

End Sub
4

2 に答える 2

1

with前のシートのステートメントにあり、ステートメントactivesheetが存在しません。使用する：

.Cells(rFound.Row, 11).Resize(,2).Copy activesheet.Cells(cel.Row, 11)

またOn Error Resume Next、返される範囲が になるので必要ありません。また、各検索を完了した後nothingに確認してください。set rFound = nothing

NextCel:
set rFound = nothing

私のコード:

Option Explicit

Sub FindCopy_all()

    Dim calc As Long
    Dim Cel As Range
    Dim LastRow As Long
    Dim rFound As Range
    Dim LookRange As Range
    Dim CelValue As Variant

     ' Speed
    calc = Application.Calculation
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

     'Get Last row of data ActiveSheet, Col A
    LastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row

     ' Set range to look in
    Set LookRange = ActiveSheet.Range("A1:A" & LastRow)

     ' Loop on each value (cell)
    For Each Cel In LookRange
         ' Get value to find
        CelValue = Cel.Value
         ' Look on previous sheet
        With Sheets(Sheets.Count - 1)

            Set rFound = .Range("A:A").Find(What:=CelValue, _
            After:=.Cells(1, 1), LookIn:=xlValues, _
            Lookat:=xlWhole, MatchCase:=False)

             ' Not found, go next
            If rFound Is Nothing Then
                GoTo NextCel
            Else
                 ' Found. last sheet, Col K & L to Active Sheet found Row, Col K & L
                .Cells(rFound.Row, 11).Resize(, 2).Copy ActiveSheet.Cells(Cel.Row, 11)
            End If
        End With
NextCel:
    Set rFound = Nothing
    Next Cel

    With Application
        .Calculation = calc
        .ScreenUpdating = True
    End With

End Sub
于 2013-04-11T11:34:59.413 に答える
0

私の提案は、VBA コードで VLOOKUP 数式を新しいワークシートに配置して、次のような請求書情報を取得することです。

activesheet.Cells(cel.Row, 11).formula="=VLOOKUP(...)"

次に、数式をコードで使用できるテキストに置き換えるために

activesheet.Cells(cel.Row, 11).Copy

に続く

activesheet.Cells(cel.Row, 11).PasteSpecial xlPasteValues式をテキスト値だけに置き換える

私のコードを試してください

 ' Speed
calc = Application.Calculation
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

 'Get Last row of data ActiveSheet, Col A
LastRow = ActiveSheet.Cells(activesheet.rows.count, 1).End(xlUp).Row

 ' Set VLOOKUP formula, search on the other sheet for the value in column A, return the value matchiung from column 11, and use EXACT MATCH.
'
' =VLOOKUP(A:A,Sheet1!A:L,11,FALSE) ' example
'
range("K1:K" & lastRow).formula="=VLOOKUP(A:A," & sheets(Worksheets.count-1).name & "!A:L,11, FALSE)"

activesheet.calculate
range("K1:K" & lastRow).copy
range("K1:K" & lastRow).pastespecial xlpastevalues ' remove the formulas

開始する必要があります。それをステップスルーして、VLOOKUP が正しい列で動作していることを確認し、どのように取得するかをお知らせください。

フィリップ

于 2013-04-14T21:08:33.893 に答える