Reverse For Next Loop 没有完全循环
Reverse For Next Loop not fully looping
我有一个 excel 用户窗体,其中包含一个列表框和命令按钮。我希望能够 select 列表框中的多行,并在使用命令按钮时将它们从数据库范围中删除。
命名范围遍历字典,其中键作为范围单元格值,项目作为单元格地址。列表框 selection 通过字典弹出到 return 要删除的单元格位置。
目前,当我将 selection 设为最底部时,selection 是唯一被删除的条目。 For Next 循环应该从 listbox.count-1 开始,一直到 0。但是,它似乎没有完全循环,也没有错误消息。想法?
Private Sub RemoveAnalyst()
' Select Tools->References from the Visual Basic menu.
' Check box beside "Microsoft Scripting Runtime" in the list.
Dim ws As Worksheet
Dim i As Long
Dim Location As String
Dim MsgDelete As String
Dim xCount As Integer
Dim xFound As Integer
Dim Cell As Range
Dim dict As Scripting.Dictionary
Set ws = ThisWorkbook.Sheets("Lists")
'Build Dictionary
Set dict = New Scripting.Dictionary
dict.CompareMode = vbTextCompare 'Capitalization does not apply to dictionary
For Each Cell In Range("Name").Cells 'Add named range to dictionary
With Cell
dict(Cell.Value) = Cell.Address(RowAbsolute:=False, ColumnAbsolute:=False) 'Key = Cell value (ie. Analyst name), Item = Cell address (ie. A2)
End With
Next Cell
Set xCount = RemoveAnalystLB.ListCount - 1
For i = xCount To 0 Step -1 'Reverse For Loop
If RemoveAnalystLB.Selected(i) Then
With ws
Location = dict(RemoveAnalystLB.List(i)) 'Find Cell location via dictionary function
xFound = xFound + 1
MsgDelete = MsgDelete & vbCrLf & RemoveAnalystLB.List(i)
.Range(Location).Delete Shift:=xlUp 'Delete cell at specified location
End With
End If
Next i
Set dict = Nothing
Unload Remove_Analyst_Form 'Close out userform
If xFound <> 0 Then MsgBox ("Analyst(s):" & MsgDelete & vbCrLf & "have been deleted from the database.") 'Msg names have been deleted
End Sub
试试这个
Private Sub RemoveAnalyst()
'Tools ->References -> Microsoft Scripting Runtime
'-------------------------------------------------
Dim ws As Worksheet
Dim dict As Scripting.Dictionary
Dim cell As Range
Dim rng As Range
Dim location As String
Dim msgDelete As String
Dim xCount As Integer
Dim xFound As Integer
Dim i As Long
Set ws = ThisWorkbook.Sheets("Lists")
Set dict = New Scripting.Dictionary
dict.CompareMode = vbTextCompare
For Each cell In Range("Name").Cells
With cell
dict(cell.Value) = cell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
End With
Next cell
xCount = RemoveAnalystLB.ListCount - 1
For i = xCount To 0 Step -1
If RemoveAnalystLB.Selected(i) Then
With ws
location = dict(RemoveAnalystLB.List(i))
xFound = xFound + 1
msgDelete = msgDelete & vbCrLf & RemoveAnalystLB.List(i)
If rng Is Nothing Then Set rng = .Range(location) Else Set rng = Union(rng, .Range(location))
End With
End If
Next i
Set dict = Nothing
Unload Remove_Analyst_Form
If Not rng Is Nothing Then rng.Delete Shift:=xlUp
If xFound <> 0 Then MsgBox ("Analyst(s):" & msgDelete & vbCrLf & "Have Been Deleted From The Database.")
End Sub
我有一个 excel 用户窗体,其中包含一个列表框和命令按钮。我希望能够 select 列表框中的多行,并在使用命令按钮时将它们从数据库范围中删除。
命名范围遍历字典,其中键作为范围单元格值,项目作为单元格地址。列表框 selection 通过字典弹出到 return 要删除的单元格位置。
目前,当我将 selection 设为最底部时,selection 是唯一被删除的条目。 For Next 循环应该从 listbox.count-1 开始,一直到 0。但是,它似乎没有完全循环,也没有错误消息。想法?
Private Sub RemoveAnalyst()
' Select Tools->References from the Visual Basic menu.
' Check box beside "Microsoft Scripting Runtime" in the list.
Dim ws As Worksheet
Dim i As Long
Dim Location As String
Dim MsgDelete As String
Dim xCount As Integer
Dim xFound As Integer
Dim Cell As Range
Dim dict As Scripting.Dictionary
Set ws = ThisWorkbook.Sheets("Lists")
'Build Dictionary
Set dict = New Scripting.Dictionary
dict.CompareMode = vbTextCompare 'Capitalization does not apply to dictionary
For Each Cell In Range("Name").Cells 'Add named range to dictionary
With Cell
dict(Cell.Value) = Cell.Address(RowAbsolute:=False, ColumnAbsolute:=False) 'Key = Cell value (ie. Analyst name), Item = Cell address (ie. A2)
End With
Next Cell
Set xCount = RemoveAnalystLB.ListCount - 1
For i = xCount To 0 Step -1 'Reverse For Loop
If RemoveAnalystLB.Selected(i) Then
With ws
Location = dict(RemoveAnalystLB.List(i)) 'Find Cell location via dictionary function
xFound = xFound + 1
MsgDelete = MsgDelete & vbCrLf & RemoveAnalystLB.List(i)
.Range(Location).Delete Shift:=xlUp 'Delete cell at specified location
End With
End If
Next i
Set dict = Nothing
Unload Remove_Analyst_Form 'Close out userform
If xFound <> 0 Then MsgBox ("Analyst(s):" & MsgDelete & vbCrLf & "have been deleted from the database.") 'Msg names have been deleted
End Sub
试试这个
Private Sub RemoveAnalyst()
'Tools ->References -> Microsoft Scripting Runtime
'-------------------------------------------------
Dim ws As Worksheet
Dim dict As Scripting.Dictionary
Dim cell As Range
Dim rng As Range
Dim location As String
Dim msgDelete As String
Dim xCount As Integer
Dim xFound As Integer
Dim i As Long
Set ws = ThisWorkbook.Sheets("Lists")
Set dict = New Scripting.Dictionary
dict.CompareMode = vbTextCompare
For Each cell In Range("Name").Cells
With cell
dict(cell.Value) = cell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
End With
Next cell
xCount = RemoveAnalystLB.ListCount - 1
For i = xCount To 0 Step -1
If RemoveAnalystLB.Selected(i) Then
With ws
location = dict(RemoveAnalystLB.List(i))
xFound = xFound + 1
msgDelete = msgDelete & vbCrLf & RemoveAnalystLB.List(i)
If rng Is Nothing Then Set rng = .Range(location) Else Set rng = Union(rng, .Range(location))
End With
End If
Next i
Set dict = Nothing
Unload Remove_Analyst_Form
If Not rng Is Nothing Then rng.Delete Shift:=xlUp
If xFound <> 0 Then MsgBox ("Analyst(s):" & msgDelete & vbCrLf & "Have Been Deleted From The Database.")
End Sub