excel 错误1004：尝试移动数据时出现应用程序定义或对象定义的错误

pexxcrt2  于 2023-06-25  发布在  其他
关注(0)|答案(1)|浏览(134)

我的工作簿中有多个工作表，其中我正在处理工作表> 500和工作表<500。
我试图在删除1列或多列数据后，在两个工作表中移动数据。G1到V1包含日期并不断变化。G1包含今天的日期，H1包含昨天的日期。我正在下载数据，并将其保存在G2到V983（> 500）和G2到V598（<500）中。一旦日期发生变化，G1将更改为当前日期，依此类推。因为我下载的数据只到昨天。因此，我从一个工作表（> 500）中删除从V2到V（最后一行）的数据，并将数据从G2剪切到U（最后一行），然后将其粘贴到一个工作表的H2到V（最后一行），并对另一个工作表（<500）执行相同的操作。
我可能会在2/3/4天后打开床单。在这种情况下，我需要从2/3/4列中删除数据并相应地移动数据。因此，我将X3（下载的数据日期）与G1，H1等进行比较以转移数据。当我运行宏，它能够删除数据frim V2到V（最后一行）为> 500张，并能够削减数据从G2到U（最后一行），并粘贴在H2到V（最后一行）为> 500张。它能够删除数据frim V2到V（最后一行）为<500张，但无法削减数据从G2到U（最后一行），并粘贴在H2到V（最后一行）为<500张。错误1004：此行中的应用程序定义或对象定义。我不知道为什么我得到这个错误。

    • 注**：两张表中也有一些空白单元格，如假设G50到V50为空，G80到L80为空等。

我尝试清除内容而不是删除，但它不起作用。
这里是我的宏供参考。

Sub shiftData()
    
    Dim LR As Integer, LR1 As Integer, FC As Integer
    LR = Worksheets(">500").Cells(Rows.Count, 2).End(xlUp).Row
    LR1 = Worksheets("<500").Cells(Rows.Count, 2).End(xlUp).Row
    FC = Worksheets(">500").Range("V2").End(xlToLeft).Column
    MsgBox LR '938
    MsgBox LR1 '598
    MsgBox FC '7

    If Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("G1").Value Then
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("H1").Value Then
        'Worksheets(">500").Range("V2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range("V2:V" & LR).ClearContents
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 21)).Cut Worksheets(">500").Range(Cells(2, (FC + 1)), Cells(LR, 22))
        'Worksheets(">500").Range(Cells(2, 7), Cells(LR, 21)).Cut Worksheets(">500").Range(Cells(2, 8), Cells(LR, 22))
        'Worksheets("<500").Range("V2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range("V2:V" & LR1).ClearContents

        'Getting Error "1004: Application-defined or Object-defined" in below line

        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 21)).Cut Worksheets("<500").Range(Cells(2, (FC + 1)), Cells(LR1, 22))
        'Worksheets("<500").Range(Cells(2, 7), Cells(LR1, 21)).Cut Worksheets("<500").Range(Cells(2, 8), Cells(LR1, 22))
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("I1").Value Then
        Worksheets(">500").Range("U2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 20)).Cut Worksheets(">500").Range(Cells(2, (FC + 2)), Cells(LR, 22))
        Worksheets("<500").Range("U2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 20)).Cut Worksheets("<500").Range(Cells(2, (FC + 2)), Cells(LR1, 22))
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("J1").Value Then
        Worksheets(">500").Range("T2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 19)).Cut Worksheets(">500").Range(Cells(2, (FC + 3)), Cells(LR, 22))
        Worksheets("<500").Range("T2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 19)).Cut Worksheets("<500").Range(Cells(2, (FC + 3)), Cells(LR1, 22))
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("K1").Value Then
        Worksheets(">500").Range("S2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 18)).Cut Worksheets(">500").Range(Cells(2, (FC + 4)), Cells(LR, 22))
        Worksheets("<500").Range("S2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 18)).Cut Worksheets("<500").Range(Cells(2, (FC + 4)), Cells(LR1, 22))
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("L1").Value Then
        Worksheets(">500").Range("R2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 17)).Cut Worksheets(">500").Range(Cells(2, (FC + 5)), Cells(LR, 22))
        Worksheets("<500").Range("R2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 17)).Cut Worksheets("<500").Range(Cells(2, (FC + 5)), Cells(LR1, 22))
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("M1").Value Then
        Worksheets(">500").Range("Q2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 16)).Cut Worksheets(">500").Range(Cells(2, (FC + 6)), Cells(LR, 22))
        Worksheets("<500").Range("Q2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 16)).Cut Worksheets("<500").Range(Cells(2, (FC + 6)), Cells(LR1, 22))
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("N1").Value Then
        Worksheets(">500").Range("P2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 15)).Cut Worksheets(">500").Range(Cells(2, (FC + 7)), Cells(LR, 22))
        Worksheets("<500").Range("P2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 15)).Cut Worksheets("<500").Range(Cells(2, (FC + 7)), Cells(LR1, 22))
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("O1").Value Then
        Worksheets(">500").Range("O2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 14)).Cut Worksheets(">500").Range(Cells(2, (FC + 8)), Cells(LR, 22))
        Worksheets("<500").Range("O2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 14)).Cut Worksheets("<500").Range(Cells(2, (FC + 8)), Cells(LR1, 22))
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("P1").Value Then
        Worksheets(">500").Range("N2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 13)).Cut Worksheets(">500").Range(Cells(2, (FC + 9)), Cells(LR, 22))
        Worksheets("<500").Range("N2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 13)).Cut Worksheets("<500").Range(Cells(2, (FC + 9)), Cells(LR1, 22))
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("Q1").Value Then
        Worksheets(">500").Range("M2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 12)).Cut Worksheets(">500").Range(Cells(2, (FC + 10)), Cells(LR, 22))
        Worksheets("<500").Range("M2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 12)).Cut Worksheets("<500").Range(Cells(2, (FC + 10)), Cells(LR1, 22))
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("R1").Value Then
        Worksheets(">500").Range("L2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 11)).Cut Worksheets(">500").Range(Cells(2, (FC + 11)), Cells(LR, 22))
        Worksheets("<500").Range("L2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 11)).Cut Worksheets("<500").Range(Cells(2, (FC + 11)), Cells(LR1, 22))
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("S1").Value Then
        Worksheets(">500").Range("K2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 10)).Cut Worksheets(">500").Range(Cells(2, (FC + 12)), Cells(LR, 22))
        Worksheets("<500").Range("K2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 10)).Cut Worksheets("<500").Range(Cells(2, (FC + 12)), Cells(LR1, 22))
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("T1").Value Then
        Worksheets(">500").Range("J2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 9)).Cut Worksheets(">500").Range(Cells(2, (FC + 13)), Cells(LR, 22))
        Worksheets("<500").Range("J2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 9)).Cut Worksheets("<500").Range(Cells(2, (FC + 13)), Cells(LR1, 22))
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("U1").Value Then
        Worksheets(">500").Range("I2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 8)).Cut Worksheets(">500").Range(Cells(2, (FC + 14)), Cells(LR, 22))
        Worksheets("<500").Range("I2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 8)).Cut Worksheets("<500").Range(Cells(2, (FC + 14)), Cells(LR1, 22))
    ElseIf Worksheets(">500").Range("X3").Value = Worksheets(">500").Range("V1").Value Then
        Worksheets(">500").Range("H2:V" & LR).Delete Shift:=xlUp
        Worksheets(">500").Range(Cells(2, FC), Cells(LR, 7)).Cut Worksheets(">500").Range(Cells(2, (FC + 15)), Cells(LR, 22))
        Worksheets("<500").Range("H2:V" & LR1).Delete Shift:=xlUp
        Worksheets("<500").Range(Cells(2, FC), Cells(LR1, 7)).Cut Worksheets("<500").Range(Cells(2, (FC + 15)), Cells(LR1, 22))
    Else
        Worksheets(">500").Range("G2:V" & LR).Delete Shift:=xlUp
        Worksheets("<500").Range("G2:V" & LR1).Delete Shift:=xlUp
    End If
    
End Sub
excel

1条答案

按热度按时间
xfb7svmp

xfb7svmp1#

使用Do While/Loop计算要移动的列数，然后使用resize和offset确定要剪切/粘贴的范围

Option Explicit

Sub shiftData()

    Const COL_FIRST = "G"
    Const COL_LAST = "V"

    Dim ws1 As Worksheet, ws2 As Worksheet, ws, dtData As Date
    Dim rngDate As Range, lastRow1 As Long, lastRow2 As Long
    Dim firstCol As Long, lastCol As Long, endCol As Long, cols As Long
    
    With ThisWorkbook
        Set ws1 = .Sheets("<500")
        Set ws2 = .Sheets(">500")
    End With
    
    With ws1 ' <500
       lastRow1 = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With
    
    With ws2 ' >500
       dtData = .Range("X3").Value2 ' download date
       Set rngDate = Cells(1, COL_FIRST)
       firstCol = rngDate.Column
       lastCol = ws2.Cells(1, COL_LAST).Column
       lastRow2 = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With
    
    MsgBox "Download date is " & dtData & vbLf & _
    ws1.Name & "last row=" & lastRow1 & vbLf & ws2.Name & "last row=" & lastRow2 & " first col " & firstCol
    
    ' calculate number of columns to shift
    cols = 0
    Do While rngDate.Value2 > dtData
       Set rngDate = rngDate.Offset(, 1) ' next column
       If rngDate.Column > lastCol Then
           ws1.Range(COL_FIRST & "2:" & COL_LAST & lastRow1).ClearContents
           ws2.Range(COL_FIRST & "2:" & COL_LAST & lastRow2).ClearContents
           MsgBox "All data cleared ", vbExclamation
           Exit Sub
       End If
       cols = cols + 1
    Loop
    
    If cols = 0 Then
        MsgBox "Nothing to move", vbInformation
    Else
        endCol = lastCol - cols ' 22=V
        
        ' cut/paste data columns for each sheet
        For Each ws In Array(ws1, ws2)
            
            With ws.Cells(2, firstCol).Resize(lastRow1 - 1, endCol - firstCol + 1)
                 MsgBox "Sheet " & ws.Name & " Moving range " & .Address, vbInformation, "Shift right " & cols & " columns "
                .Cut .Offset(, cols)
            End With
            ' clear any remaining data
            With ws.Cells(2, firstCol).Resize(lastRow1 - 1, cols)
                MsgBox "Clearing " & ws.Name & " " & .Address
                .ClearContents
            End With
        Next
    End If
   
End Sub
赞(0）分享  回复(0）举报  2023-06-25
我来回答

相关问题

    查看更多

    热门标签

    更多
    JavaquerypythonNode开发语言requestUtil数据库Table后端算法LoggerMessageElementParser

    最新问答

    更多
    • 蜀ICP备2022004421号-2 NULL123 https://www.null123.com © All rights reserved
    • 本站内容来源互联网,如果侵犯您的权益请联系我们删除, 联系方式：448109455@qq.com