excel赢得'；t在运行程序后关闭

我运行此代码，excel会话不会破坏或关闭。我知道我没有使用sheets.add或ws.delete，因为它表示带有验证，我不知道如何使用声明对象的单行。我不知道我猜的语法。这是代码。有人能指出怎么修理吗

Public Function ComboLists()
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim MyFileName As String
Dim bfile As String
Dim MyList(1) As String
Dim lRow As Long

bfile = "S:\_Reports\KSMS\Designated Letter\KSMS Designated Letter - "

MyFileName = bfile & Format(Date, "mm-dd-yyyy") & ".xls"

On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
On Error GoTo 0

Set wb = xlApp.Workbooks.Open(MyFileName)
Set ws = wb.Sheets(1)
ws.Activate
xlApp.DisplayAlerts = False

MyList(0) = "Approve Location"
MyList(1) = "Delete Location"

lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

i = 2

For Each c In wb.Sheets(1).Range("M" & lRow)

If ws.Cells(i, 12).Value = "US" Then
rng = "M" & i '& ":" & "Z" & i

With Range(rng).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
     Operator:=xlBetween, Formula1:=Join(MyList, ",")
wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
End With
Else
rng = "A" & i & ":" & "L" & i
With xlApp.Range(rng).Validation
ws.Delete
wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
'wb.Close savechanges:=False
End With
End If


i = i + 1

Next c

Set ws = wb.Sheets(1)
ws.Activate

ws.Cells.Rows("1:1").Select

wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
wb.Close savechanges:=False

xlApp.Quit
xlApp.Quit
xlApp.Quit
xlApp.Quit

Set xlApp = Nothing
Set wb = Nothing
Set ws = Nothing

Exit Function

End Function

如果您能在这方面提供帮助，我将不胜感激。

更改

lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

到

否则，在代码完成后，您仍将拥有对Excel应用程序的引用

对于非限定的

行

，您的应用程序（Word？Access？PowerPoint？）需要创建一个虚拟的

ActiveSheet

对象以供方法使用。在销毁该虚拟对象之前，需要维护Excel实例。在您退出应用程序之前，该对象不会被销毁，因此Excel实例将一直挂起，直到您退出应用程序

---

我最初没有发现它，但您也有一个不合格的

范围

With Range(rng).Validation

需要

With ws.Range(rng).Validation

---

使用多个应用程序对象的黄金法则是始终完全限定所有内容

Public Function ComboLists()
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim MyFileName As String
Dim bfile As String
Dim MyList(1) As String
Dim lRow As Long

bfile = "S:\_Reports\KSMS\Designated Letter\KSMS Designated Letter - "

MyFileName = bfile & Format(Date, "mm-dd-yyyy") & ".xls"

On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
On Error GoTo 0

Set wb = xlApp.Workbooks.Open(MyFileName)
Set ws = wb.Sheets(1)
ws.Activate
xlApp.DisplayAlerts = False

MyList(0) = "Approve Location"
MyList(1) = "Delete Location"

lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

MsgBox lRow

i = 2

'For Each c In wb.Sheets(1).Range("M2:M1000") '" & Range("V" & Rows.count).End(xlUp).Row)
For Each c In wb.Sheets(1).Range("M" & lRow)

If ws.Cells(i, 12).Value = "US" Then
rng = "M" & i '& ":" & "Z" & i

With xlApp.Range(rng).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
     Operator:=xlBetween, Formula1:=Join(MyList, ",")
wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
DoEvents
End With
Else
rng = "A" & i & ":" & "L" & i
With xlApp.Range(rng).Validation
ws.Delete
wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
DoEvents
End With
DoEvents
End If

i = i + 1

Next c

DoEvents

Set ws = wb.Sheets(1)
ws.Activate

ws.Cells.Rows("1:1").Select

wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
wb.Close savechanges:=False
DoEvents
MsgBox "quit"
xlApp.Quit

Set xlApp = Nothing
Set wb = Nothing
Set ws = Nothing

Exit Function

End Function

---

我添加lrow lrow=ws.Cells（ws.Rows.Count，1）.End（xlUp）.Row我添加了ws。在单元格前面，ws在行前面，这有助于破坏会话

此代码在哪里运行？如果它在Excel中运行，那么您根本不需要变量

xlApp

。我相信问题在于运行代码的工作簿已关闭，因此，宏停止在

wb.Close

行之外运行。它打开一个工作簿并向循环中的单元格中添加下拉列表validatioin。我用以下代码修复了它：正确限定

Range

对象也是一个好主意-

xlApp.Range

等效于

xlApp.ActiveWorkbook.ActiveSheet.Range

。最好使用

ws.Range

，它精确地指定您所引用的Excel实例中的哪个工作簿中的哪个工作表。

Public Function ComboLists()
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim MyFileName As String
Dim bfile As String
Dim MyList(1) As String
Dim lRow As Long

bfile = "S:\_Reports\KSMS\Designated Letter\KSMS Designated Letter - "

MyFileName = bfile & Format(Date, "mm-dd-yyyy") & ".xls"

On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
On Error GoTo 0

Set wb = xlApp.Workbooks.Open(MyFileName)
Set ws = wb.Sheets(1)
ws.Activate
xlApp.DisplayAlerts = False

MyList(0) = "Approve Location"
MyList(1) = "Delete Location"

lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

MsgBox lRow

i = 2

'For Each c In wb.Sheets(1).Range("M2:M1000") '" & Range("V" & Rows.count).End(xlUp).Row)
For Each c In wb.Sheets(1).Range("M" & lRow)

If ws.Cells(i, 12).Value = "US" Then
rng = "M" & i '& ":" & "Z" & i

With xlApp.Range(rng).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
     Operator:=xlBetween, Formula1:=Join(MyList, ",")
wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
DoEvents
End With
Else
rng = "A" & i & ":" & "L" & i
With xlApp.Range(rng).Validation
ws.Delete
wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
DoEvents
End With
DoEvents
End If

i = i + 1

Next c

DoEvents

Set ws = wb.Sheets(1)
ws.Activate

ws.Cells.Rows("1:1").Select

wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
wb.Close savechanges:=False
DoEvents
MsgBox "quit"
xlApp.Quit

Set xlApp = Nothing
Set wb = Nothing
Set ws = Nothing

Exit Function

End Function