Private Sub Comm_底_Click()
    Dim a, b
    Indexs = List_待选.ListIndex
    If Indexs >= 0 Then
        a = List_待选.List(Indexs)
        b = List_待选.Selected(Indexs)
        For i = Indexs To List_待选.ListCount - 2
            List_待选.List(i) = List_待选.List(i + 1)
            List_待选.Selected(i) = List_待选.Selected(i + 1)
            DoEvents
        Next
        List_待选.List(List_待选.ListCount - 1) = a
        List_待选.Selected(List_待选.ListCount - 1) = b
    End If
    Indexs = -1
End Sub

Private Sub List_待选_GotFocus()
    Client = False
    Command_Save_Click
End Sub
Private Sub List_待选_LostFocus()
    Client = True
End Sub
Private Sub Command_Save_Click()
    Lista = ""
    For xf = 0 To List_待选.ListCount - 1
        Lista = Lista & List_待选.List(xf) & "<>" & List_待选.Selected(xf) & "|"
        DoEvents
    Next
    If Lista <> "" Then WriteInI "List", "List_待选", Lista, BasePath & "\Uservar(勿删).ini"
End Sub
Private Sub Comm_顶_Click()
    Dim a, b
    Indexs = List_待选.ListIndex
    If Indexs > 0 Then
        a = List_待选.List(Indexs)  '记住上一个的位置
        b = List_待选.Selected(Indexs)
        For i = Indexs To 1 Step -1
            List_待选.List(i) = List_待选.List(i + 1)
            List_待选.Selected(i) = List_待选.Selected(i + 1)
        Next
        List_待选.List(0) = a
        List_待选.Selected(0) = b
    End If
    Indexs = -1
End Sub
我这个存在问题就是移至顶部或者底部时间会产生重复项,研究了n天一直找到不解决办法,请大神帮忙(注:不要单纯两个位置的交换,那样的没有意义,要排列非常费时间)

把到顶的+1改成-1，如下：
Private Sub Comm_顶_Click()
    Dim a, b
    Indexs = List_待选.ListIndex
    If Indexs > 0 Then
        a = List_待选.List(Indexs)  '记住上一个的位置
        b = List_待选.Selected(Indexs)
        For i = Indexs To 1 Step -1
            List_待选.List(i) = List_待选.List(i - 1)
            List_待选.Selected(i) = List_待选.Selected(i - 1)
        Next
        List_待选.List(0) = a
        List_待选.Selected(0) = b
    End If
    Indexs = -1
End Sub

其实，可以更简单些，如下：
Private Sub Comm_底_Click()
    Dim a As String, i As Integer
    i = List_待选.ListIndex
    If i >= 0 Then
        a = List_待选.List(i)
        List_待选.RemoveItem (i)
        List_待选.AddItem a
        List_待选.Selected(List_待选.ListCount - 1) = True
    End If
End Sub

Private Sub Comm_顶_Click()
    Dim a As String, i As Integer, j As Integer
    j = List_待选.ListIndex
    If j > 0 Then
        For i = j To 1 Step -1
          a = List_待选.List(i)
          List_待选.List(i) = List_待选.List(i - 1)
          List_待选.List(i - 1) = a
        Next
        List_待选.Selected(0) = True
    End If
End Sub

[ 本帖最后由 lowxiong 于 2014-3-18 23:41 编辑 ]

推荐用按键控制：
vbKeyHome
vbKeyEnd
vbKeyPageUp
vbKeyPageDown

谢谢了,你写的目前测试比我的好用,现在要怎么把分给你,3楼的建议也不错