Sortierung in aufsteigender Reihenfolge, indem der Minimalwert jedes Mal gelöscht wird, wenn die Schleife das nächste Minimum findet

Question

Ich versuche gerade, einen Code auf VBA zu erstellen, der meine Werte in aufsteigender Reihenfolge sortiert. Nachdem mein Programm den Minimalwert gefunden hat und es zu einer anderen Spalte der Spalte "B" hinzufügt, wollte ich die Zelle des Minimums verschwinden lassen, um mein neues Minimum zu finden und es in die Spalte "B" direkt unter dem Anfangswert einzugeben . Hier ist mein Code. Aus irgendeinem Grund löscht es die Zelle nicht und gibt mir einen "Objekt erforderlicher Fehler". Bitte helfen

Option Explicit 
Sub decreasing() 
Dim a As Range, b As Range 
Dim i As Integer 
Dim n As Long 
Dim minimum As Long 

n = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row 

i = 1 

While Cells(i, "A") <> "" 
i = i + 1 
For i = 1 To n 

    Set a = Range(Cells(1, "A"), Cells(n, "A")) 

Cells(i, "B") = Application.WorksheetFunction.Min(a) 

Application.Min(a).Cells.Delete 



    Next i 
Wend 


End Sub 

Answer 1

Min() einen Wert zurückgibt, kein Kreisobjekt. Sie müssten Find() oder Match() verwenden, um die Zelle mit dem Wert Minimum zu suchen und sie dann zu löschen. Vielleicht finden Sie es einfacher Application.Small(a, i) in Ihrem Schleife verwenden: dann würden Sie nicht die Zellen, die Sie haben bereits

kopiert löschen müssen

Sub decreasing() 

    Dim a As Range, b As Range 
    Dim i As Integer 
    Dim n As Long 
    Dim minimum As Long 

    n = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row 
    Set a = Sheet1.Range(Sheet1.Cells(1, "A"), Sheet1.Cells(n, "A")) 

    For i = 1 To Application.Count(a) 
     Sheet1.Cells(i, "B").Value = Application.Small(a, i) 
    Next i 

End Sub 

Answer 2

da man das Rad nicht neu erfinden zu sortier tun und verwenden Sort() Verfahren Range Objekt:

Sub decreasing2()   
    With Sheet1 
     With .Range("A1", .Cells(Rows.COUNT, 1).End(xlUp)) 
      .Offset(, 1).Value = .Value 
      .Offset(, 1).Sort key1:=Range("B1"), order1:=xlAscending, Header:=xlYes ' 
     End With 
    End With 
End Sub