Excel 错误400

2025-03-22 11:42:24

推荐回答（2个）

回答1：

我晕。你这个问题太麻烦了。问题不是出在这个上面。
出在你的保护工作表上面。

代码我发出来。你采纳把。
Sub 保存数据_单击()
Dim irow As Integer '计行数
Dim icol As Integer '计列数
Dim kk As Integer
kk = 0
Application.ScreenUpdating = False

'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@先查漏！！！！
With Sheets("录入表")
.Unprotect 1234 '解除工作表保护
For i = 4 To 37
For j = 3 To 7
If .Cells(i, j) = "" And i <> 20 Then '如果单元格为空
.Cells(i, j).Interior.ColorIndex = 3 '设置底色为红色
kk = kk + 1
End If
Next
For j = 10 To 14
If .Cells(i, j) = "" And i <> 20 Then '如果单元格为空
.Cells(i, j).Interior.ColorIndex = 3 '设置底色为红色
kk = kk + 1
End If
Next
Next
End With
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@如果有漏则提示，并终止程序
If kk > 0 Then
MsgBox "红色单元格内数据漏填！"
Exit Sub
End If
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'用百分号包围的代码可以优化的。。。你自己优化一下
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@没有漏填，则赋值
Set lrb = Sheets("录入表")
Set Glb1 = Sheets("过录表1")
Set Glb2 = Sheets("过录表2")
Glb1.Range("A5").Value = lrb.Range("A3").Value '传递表编号
Glb2.Range("A5").Value = lrb.Range("A3").Value

'****************************************************************************************
icol = 2
For irow = 4 To 19
lrb.Range(Cells(irow, 3), Cells(irow, 7)).Copy Glb1.Cells(5, icol) '将录入表中第irow数据写入过录表1中第5行（左半边）
Glb1.Cells(5, icol + 5) = WorksheetFunction.Sum(Glb1.Range(Glb1.Cells(5, icol), Glb1.Cells(5, icol + 4))) '每行数据后的汇总数据
lrb.Range(Cells(irow, 10), Cells(irow, 14)).Copy Glb1.Cells(5, icol + 96) '将录入表中第irow数据写入过录表1中第5行（右半边）
Glb1.Cells(5, icol + 101) = Application.Sum(Glb1.Range(Glb1.Cells(5, icol + 96), Glb1.Cells(5, icol + 100)))
icol = icol + 6
Next

'****************************************************************************************
icol = 194
For irow = 21 To 27
lrb.Range(Cells(irow, 3), Cells(irow, 7)).Copy Glb1.Cells(5, icol) ''第r行数据，复制第五行数据，粘贴到第六行
Glb1.Cells(5, icol + 5) = WorksheetFunction.Sum(Glb1.Range(Glb1.Cells(5, icol), Glb1.Cells(5, icol + 4)))
lrb.Range(Cells(irow, 10), Cells(irow, 14)).Copy Glb2.Cells(5, icol - 132) ''第r行数据，复制第五行数据，粘贴到第六行
Glb2.Cells(5, icol - 127) = WorksheetFunction.Sum(Glb2.Range(Glb2.Cells(5, icol - 132), Glb2.Cells(5, icol - 128)))
icol = icol + 6
Next irow
'****************************************************************************************
icol = 2
For irow = 28 To 36
lrb.Range(Cells(irow, 3), Cells(irow, 7)).Copy Glb2.Cells(5, icol) ''第r行数据，复制第五行数据，粘贴到第六行
Glb2.Cells(5, icol + 5) = WorksheetFunction.Sum(Glb2.Range(Glb2.Cells(5, icol), Glb2.Cells(5, icol + 4)))
lrb.Range(Cells(irow, 10), Cells(irow, 14)).Copy Glb2.Cells(5, icol + 102) ''第r行数据，复制第五行数据，粘贴到第六行
Glb2.Cells(5, icol + 107) = WorksheetFunction.Sum(Glb2.Range(Glb2.Cells(5, icol + 102), Glb2.Cells(5, icol + 106)))
icol = icol + 6
Next irow

'****************************************************************************************

Glb2.Cells(5, 127).Interior.ColorIndex = 36

'第37行数据的过录
lrb.Range(Cells(37, 3), Cells(37, 7)).Copy Glb2.Cells(5, 56) ''第r行数据，复制第五行数据，粘贴到第六行
Glb2.Cells(5, 61) = WorksheetFunction.Sum(Glb2.Range(Glb2.Cells(5, 56), Glb2.Cells(5, 60)))
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@传递数据完毕，复制换行
With Glb1 '第五行数据
.Range("A5:IA5").Offset(1, 0).Insert '在第五行下增加一行
.Range("A5:IA5").Copy .Range("A6:IA6") '复制第五行数据，粘贴到第六行
.Range("A5:IA5").ClearContents '清除第五行数据
End With
With Glb2 '第五行数据
.Range("A5:FA5").Offset(1, 0).Insert '在第五行下增加一行
.Range("A5:FA5").Copy .Range("A6:FA6") '复制第五行数据，粘贴到第六行
.Range("A5:FA5").ClearContents '清除第五行数据
End With
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@表编号加1，赋值给录入表
lrb.Range("A3").Value = Glb1.Range("A6").Value + 1
lrb.Range("H3").Value = Glb1.Range("A6").Value + 1 '过录表标号为A6单元格数值加1,赋值给录入表编号
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@将录入表内数据清空
Sheets("录入表").Range("C4:G19,C21:G37,J4:N19,J21:N37,C38:N38").ClearContents
Application.ScreenUpdating = True
End Sub

回答2：

你的代码本身没有什么问题，但是有个瑕疵，就是每当Sheet2工作表被删除以后，Sheet2里面的代码也随之被删除，那么你的这段代码就失去了意义，建议将你的代码全部放在ThisWOrkbook模块里面，然后做适当修改即可。代码如下：

Private ctl As CommandBarButton
Sub DelSht()
    Set ctl = Application.CommandBars.FindControl(ID:=847)
    ctl.OnAction = "ThisWorkbook.MyDelSht"
End Sub
Sub ResSht()
    Application.CommandBars("Ply").Reset
End Sub
Sub MyDelSht()
    If VBA.UCase$(ActiveSheet.CodeName) = "SHEET2" Then
        MsgBox "禁止删除" & ActiveSheet.Name & "工作表!"
    Else
        ActiveSheet.Delete
    End If
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.CodeName = "Sheet2" Then Call DelSht Else Call ResSht
End Sub

其实你的提问有点模糊，不知道你是不是想连工具栏上的“删除工作表”按钮也给禁用了！？