簡體   English   中英

具有下標超出范圍錯誤的Excel VBA剪切和粘貼功能

[英]Excel VBA cut and paste function with subscript out of range error

    Sub CutandPaste()
    With ActiveSheet
        Dim i As Long
        Dim Sheet1 As Worksheet
        Dim Sheet2 As Worksheet

        Set mainsheet = ActiveWorkbook.Sheets("Sheet1")
        Set subsheet = ActiveWorkbook.Sheets("Sheet2")

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

            For i = 25 To endrow
                If mainsheet.Cells(i, "J") <> "" Or mainsheet.Cells(i, "L") <> "" Or mainsheet.Cells(i, "N") <> "" Then
                    mainsheet.Range(Cells(i, "B"), Cells(i, "O")).Cut Destination:=subsheet.Range(Cells(i + 25, "B"), Cells(i + 25, "O")).Paste
                    mainsheet.Range(Cells(i, "B"), Cells(i, "O")).Delete '~~> if you want to delete
                    i = i + 1
                End If
            Next
    End With
End Sub

我想用以下功能編寫程序

如果Sheet1中的Cell(“ J” i)或Cell(“ L” i)或Cell(“ N” i)不為空,則i等於任何整數

然后在工作表1中將Cell(“ B” i)切割為Cell(“ O” i)到Sheet2中的Cell(“ B” i + 25)切割為Cell(“ O” i + 25),其中i等於任何整數

但是,據說我的代碼超出范圍。

為什么會這樣,我該如何解決?

非常感謝

    Sub CutandPaste()
    With ActiveSheet
        Dim i As Long
        Dim Sheet1  As Worksheet
        Dim Sheet2 As Worksheet

        Set mainsheet = ActiveWorkbook.Sheets("Sheet1")
        Set subsheet = ActiveWorkbook.Sheets("Sheet2")

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

        For i = endrow To 25 Step -1

                If mainsheet.Cells(i, "J") <> "" Or mainsheet.Cells(i, "L") <> "" Or mainsheet.Cells(i, "N") <> "" Then
                    mainsheet.Range(mainsheet.Cells(i, "B"), mainsheet.Cells(i, "O")).Cut Destination:=subsheet.Range(subsheet.Cells(i + 56, "B"), subsheet.Cells(i + 56, "O")).Paste
                    mainsheet.Range(mainsheet.Cells(i, "B"), mainsheet.Cells(i, "O")).Delete '~~> if you want to delete

                End If
            Next
    End With
End Sub

最新版本:

        Sub CutandPaste()
    With ActiveSheet
        Dim i As Long
        Dim Sheet1  As Worksheet
        Dim Sheet2 As Worksheet

        Set mainsheet = ActiveWorkbook.Sheets("Sheet1")
        Set subsheet = ActiveWorkbook.Sheets("Sheet2")

        endrow = mainsheet.Range("A" & mainsheet.Rows.Count).End(xlUp).Row
        Bendrow = subsheet.Range("B" & mainsheet.Rows.Count).End(xlUp).Row + 1

        For i = endrow To 25 Step -1
                If mainsheet.Cells(i, "J") <> "" Or mainsheet.Cells(i, "L") <> "" Or mainsheet.Cells(i, "N") <> "" Then
                    mainsheet.Range(mainsheet.Cells(i, "B"), mainsheet.Cells(i, "O")).Cut Destination:=subsheet.Cells(Bendrow, "B")
                    mainsheet.Range(mainsheet.Cells(i, "B"), mainsheet.Cells(i, "O")).Delete '~~> if you want to delete
                    Bendrow = Bendrow + 1
                End If
            Next
    End With
End Sub

MainSheet數據

子表數據

問題是Range.CopyRange.CutDestination參數需要是一個范圍。 您已將其設置為范圍的Paste方法。

不正確的

mainsheet.Range(mainsheet.Cells(i,“ B”),mainsheet.Cells(i,“ O”))。剪切目標:= subsheet.Range(subsheet.Cells(i + 56,“ B”),subsheet。單元格(i + 56,“ O”))。粘貼

正確

mainsheet.Range(mainsheet.Cells(i,“ B”),mainsheet.Cells(i,“ O”))。剪切目標:= subsheet.Cells(i + 56,“ B”)

我使用子范圍重構了您的代碼。 我認為它看起來更干凈。

這是定義相同范圍的一些不同方法

Range(Cells(i,“ A”),Cells(i,“ O”))Cells(i,“ A”)。Resize(1,15)Rows(i).Range(“ A1:O1”)Rows( i).Range(“ A1:O1”)Rows(i).Resize(1,15)Rows(2).Columns(“ A:O”)

Sub CutandPaste()

    Dim i As Long
    Dim mainsheet As Worksheet
    Dim subsheet As Worksheet

    Set mainsheet = ActiveWorkbook.Sheets("Sheet1")
    Set subsheet = ActiveWorkbook.Sheets("Sheet2")

    With mainsheet
        endrow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = endrow To 25 Step -1
            If .Cells(i, "J") <> "" Or .Cells(i, "L") <> "" Or .Cells(i, "N") <> "" Then
                .Rows(i).Resize(1, 15).Cut Destination:=subsheet.Cells(i + 56, "B")
                .Rows(i).Resize(1, 15).Delete    '~~> if you want to delete
            End If
        Next
    End With
End Sub

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM