0

これが私のスクリプトです。

Sub Update_OOR()

    Dim wsTNO As Worksheet
    Dim wsTND As Worksheet
    Dim wsTNA As Worksheet
    Dim lastrow As Long, fstcell As Long

    Set wsTNO = Sheets("Tel-Nexx OOR")
    Set wsTND = Sheets("Tel-Nexx Data")
    Set wsTNA = Sheets("Tel-Nexx Archive")

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With

    With Intersect(wsTNO.UsedRange, wsTNO.Columns("S"))
        .AutoFilter 1, "<>Same"
        With Intersect(.Offset(2).EntireRow, .Parent.Range("B:P"))
            .Copy wsTNA.Cells(Rows.Count, "B").End(xlUp).Offset(1)
            .EntireRow.Delete
        End With
        .AutoFilter
    End With


'Blow away rows that are useless
    lastrow = wsTND.Range("A2").End(xlDown).Row
    wsTND.Range("O1:P1").Copy wsTND.Range("O2:P" & lastrow)
    wsTND.UsedRange.Copy Sheets.Add.Range("A1")

    With Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("P"))
        ActiveSheet.Range("O:P").Calculate
        .AutoFilter 1, "<>Different"
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    With ActiveSheet
        lastrow = wsTND.Range("A2").End(xlDown).Row
        Intersect(.UsedRange, .Range("A2:M" & lastrow)).Copy wsTNO.Cells(Rows.Count, "B").End(xlUp).Offset(1)
        .Delete
    End With

    With wsTNO
        lastrow = wsTNO.Cells(Rows.Count, "B").End(xlUp).Row
        wsTNO.Range("T1:AD1").Copy
        wsTNO.Range("B3:N" & lastrow).PasteSpecial xlPasteFormats
        lastrow = wsTNO.Cells(Rows.Count, "R").End(xlUp).Row
        fstcell = wsTNO.Cells(Rows.Count, "N").End(xlUp).Row
        wsTNO.Range("AE1:AI1").Copy wsTNO.Range("O" & fstcell & ":S" & lastrow).Offset(1, 0)
    End With

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With

End Sub

技術的にはここまで完全に機能します。

With wsTNO
        lastrow = wsTNO.Cells(Rows.Count, "B").End(xlUp).Row
        wsTNO.Range("T1:AD1").Copy
        wsTNO.Range("B3:N" & lastrow).PasteSpecial xlPasteFormats
        lastrow = wsTNO.Cells(Rows.Count, "R").End(xlUp).Row
        fstcell = wsTNO.Cells(Rows.Count, "N").End(xlUp).Row
        wsTNO.Range("AE1:AI1").Copy wsTNO.Range("O" & fstcell & ":S" & lastrow).Offset(1, 0)
End With

これで、技術的にはこの部分のすべてが正しく機能しますが、コードの最後の行はすべてを正しく貼り付けてから、1ステップ先に進みます。理由を知りたいのですが。オフセットを取り除くと、OからSまでの上のセルにあるものが上書きされます。データは特定のセル範囲にのみ書き込む必要があるため、最初と最後のセルを知る必要があります。

これを行う簡単な方法がある場合は、誰かが私に教えてくれれば幸いですが、そうでない場合は、誰かがこれを修正する方法を教えてもらえますか？

ありがとう。

添付されているのはワークブックです。

http://dl.dropbox.com/u/3327208/Excel/First%26LastRows.xlsm

4

1 に答える 1

1

2番目のコードで+1を追加します

 lastrow = wsTNO.Cells(Rows.Count, "R").End(xlUp).Row

だからあなたは

 lastrow = wsTNO.Cells(Rows.Count, "R").End(xlUp).Row + 1

前者は、ヘッダー行である行2を提供します。必要なのは、ヘッダーの直後の行3です。

更新：将来のテスト方法を示すため

.Selectメソッドは通常眉をひそめますが。テスト/デバッグに最適です。走った

wsTNO.Range("O" & fstcell & ":S" & lastrow).Select

lastrowとfstcellを設定した直後のウィンドウで、設定された範囲を見つけました。したがって、ヘッダーをコピーしたくないことはわかっていました。そこから、何がその範囲を設定し、それに応じて調整するのかを理解できます。

于 2012-05-23T18:40:37.627 に答える