Реверс для следующего цикла не полностью зациклен - PullRequest
Новая
       15

Реверс для следующего цикла не полностью зациклен

0 голосов
/ 11 января 2019

У меня есть пользовательская форма Excel, которая содержит список и командную кнопку. Я хочу иметь возможность выбрать несколько строк в списке и удалить их из диапазона базы данных при использовании кнопки команды.

Именованный диапазон проходит через словарь с ключом в качестве значений ячейки диапазона и элементом в качестве адресов ячейки. Выбор списка осуществляется через словарь, чтобы вернуть ячейку для удаления.

В настоящее время, когда я делаю свой выбор, самый нижний выбор - единственная удаленная запись. Цикл For Next должен начинаться с listbox.count-1 и работать до 0. Однако, похоже, он не зацикливается полностью и сообщений об ошибках нет. Мысли? * * 1005 

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

1 Ответ

0 голосов
/ 11 января 2019

Попробуйте это 

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
...