如何解决Excel VBA中的合格范围
我收到“1004 运行时错误”,因为我没有完全限定我的代码,但我不确定我做错了什么导致了这个问题。任何帮助将非常感激。这是我的代码:
Sub SAPMacro()
Dim PeggedWBS as Range
Dim CostObject As Range
Dim rngHeaders As Range
Dim ws As Worksheet
Dim sFindHeader As String
Dim sNewHeader As String
Dim rngCol As Range
Dim LastRow As Long
Set rngHeaders = Worksheets("Insert Zbuyr Export").Range("1:1")
sFindHeader = "Pegged WBS"
sNewHeader = "Pegged WBS Stripped"
Set PeggedWBS = rngHeaders.Find(what:=sFindHeader)
Set ws = Worksheets("Insert Zbuyr Export")
With ws
LastRow = ws.cells(.find("*",searchorder:=xlByRows,searchdirection:=xlPrevious).Row
PeggedWBS.Offset(0,1).EntireColumn.Insert
PeggedWBS.Offset(0,1).Value = sNewHeader
Set rngNewCol = Range(PeggedWBS.Offset(1,1),ws.Cells(LastRow,PeggedWBS.Offset(1,1).Columns.Column))
rngNewCol.Cells(1,1).Formula = "=1+1"
rngNewCol.Filldown
rngNewCol.Copy
rngNewCol.PasteSpecial Paste:=xlPasteValues
rngNewCol.Application.CutCopyMode = False
End With
'#### This is where I'm having my issue.
'The new sheet I'm calling isn't being activated,and
'the object isn't being defined.
Set rngHeaders = Worksheets("Insert Pegging Export").Range("1:1")
sFindHeader = "Cost Object"
sNewHeader = "Cost Object Stripped"
Set CostObject = rngHeaders.Find(what:=sFindHeader)
Set ws = Worksheets("Insert Pegging Export")
With ws
LastRow = ws.cells(.find("*",searchdirection:=xlPrevious).Row
CostObject.Offset(0,1).EntireColumn.Insert
CostObject.Offset(0,1).Value = sNewHeader
Set rngNewCol = Range(CostObject.Offset(1,CostObject.Offset(1,1).Formula = "=1+1"
rngNewCol.Filldown
rngNewCol.Copy
rngNewCol.PasteSpecial Paste:=xlPasteValues
rngNewCol.Application.CutCopyMode = False
End With
解决方法
避免重复代码
Option Explicit
Sub SAPMacro()
Const wsNamesList As String = "Insert Zbuyr Export," _
& "Insert Pegging Export"
Const OldHeadersList As String = "Pegged WBS,Cost Object"
Const NewHeadersList As String = "Pegged WBS Stripped,Cost Object Stripped"
Const FormulasList As String = "=1+1,=1+1"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim wsNames() As String: wsNames = Split(wsNamesList,",")
Dim OldHeaders() As String: OldHeaders = Split(OldHeadersList,")
Dim NewHeaders() As String: NewHeaders = Split(NewHeadersList,")
Dim Formulas() As String: Formulas = Split(FormulasList,")
Dim hCell As Range
Dim lCell As Range
Dim n As Long
For n = 0 To UBound(wsNames)
With wb.Worksheets(wsNames(n))
Set hCell = .Rows(1).Find(OldHeaders(n),xlFormulas,xlWhole)
If Not hCell Is Nothing Then
Set lCell = .Cells.Find("*",xlByRows,_
xlPrevious)
If Not lCell Is Nothing Then
' This line cannot be inside the following 'With' statement.
hCell.Offset(0,1).EntireColumn.Insert
With hCell.Offset(0,1)
.Value = NewHeaders(n)
.EntireColumn.AutoFit
End With
With hCell.Offset(1,1)
With .Resize(lCell.Row - .Row + 1)
.Formula = Formulas(n)
.Value = .Value
End With
End With
End If
End If
End With
Next n
End Sub
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。