工作表按名称排序（VBA80集第25讲课后练习题）上交专贴

huguanglinux

这节的习题，一点思路没有，看看别人怎么做的，学习一下。

kuroT

Option Explicit

Sub 工作表排序之冒泡法()

Dim arr, x, y, tem

arr = Range("a1:a" & [a65535].End(xlUp).Row)

For x = 1 To UBound(arr) - 1
  For y = x + 1 To UBound(arr)
  If arr(x, 1) > arr(y, 1) Then

     tem = arr(y, 1)
     arr(y, 1) = arr(x, 1)
     arr(x, 1) = tem

    End If
     Next y

Next x

Range("a1").Resize(UBound(arr), 1) = arr

End Sub


Sub 工作表排序之选择法()

Dim arr, x, y, tem, imax

arr = Range("a1:a" & [a65535].End(xlUp).Row)

For x = UBound(arr) To LBound(arr) + 1 Step -1
  imax = 1
  For y = LBound(arr) To x
    If arr(y, 1) > arr(imax, 1) Then
       imax = y
     End If
  Next y

    tem = arr(imax, 1)
    arr(imax, 1) = arr(x, 1)
    arr(x, 1) = tem

Next x

Range("a1").Resize(UBound(arr), 1) = arr

End Sub

Sub 工作表排序之插入法()

Dim arr, x, y, tem
arr = Range("a1:a" & [a65535].End(xlUp).Row)

For x = 2 To UBound(arr)
  tem = arr(x, 1)
  For y = x - 1 To LBound(arr) Step -1
    If tem >= arr(y, 1) Then Exit For

    arr(y + 1, 1) = arr(y, 1)

    Next y

    arr(y + 1, 1) = tem
Next x

Range("a1").Resize(UBound(arr), 1) = arr



End Sub

Sub 打乱顺序()

Dim arr, x, num, h
arr = Range("a1:a" & Range("a65535").End(xlUp).Row)
For x = 1 To UBound(arr)

  num = Int((UBound(arr) - LBound(arr) + 1) * Rnd() + LBound(arr))
  h = arr(num, 1)
  arr(num, 1) = arr(x, 1)
  arr(x, 1) = h
  Next x

Range("a1").Resize(UBound(arr), 1) = arr

End Sub

xxww_vip520

最开始就跟着学习的人，现在肯定都是VBA高手中高手了吧

李一哲8

学习一下

thengj

打发士大夫

thengj

Sub 工作表排序之冒泡法()
Dim x, y
   For x = 1 To Sheets.Count - 1
    For y = x + 1 To Sheets.Count
     If Sheets(x).Name > Sheets(y).Name Then
         Sheets(y).Move before:=Sheets(x)
     End If
    Next y
   Next x
   Sheets("王6").Select
End Sub
Sub 工作表排序之选择法()
    Dim x, y, sh
        For x = Sheets.Count To 2 Step -1
          Set sh = Sheets(1)
          For y = 1 To x
              If Sheets(y).Name > sh.Name Then Set sh = Sheets(y)
          Next y
           sh.Move after:=Sheets(x)
        Next x
        Sheets("王6").Select
End Sub
Sub 工作表排序之插入法()
Dim x, y, st
   For x = 2 To Sheets.Count
     st = Sheets(x).Name
     For y = x - 1 To 1 Step -1
      If Sheets(y).Name <= st Then Exit For
      Sheets(y).Move after:=Sheets(y + 1)
     Next y
    Next x
     Sheets("王6").Select
End Sub

Sub 打乱顺序()
Dim x, y, sh
        For x = 1 To Sheets.Count
          y = Int(Rnd() * x + 1)
           Sheets(y).Move after:=Sheets(x)
        Next x
        Sheets("王6").Select
End Sub

Sub 工作表排序之希尔排序()
Dim x, y, z, sr
  z = 1
  If Sheets.Count > 13 Then
  Do While z < Sheets.Count
    z = z * 3 + 1
    Loop
    z = z \ 9
    End If
    Do While z
    For x = 1 + z To Sheets.Count
       sr = Sheets(x).Name
      For y = x - z To 1 Step -z
        If Sheets(y).Name <= sr Then Exit For
          Sheets(y).Move after:=Sheets(y + z)
          Sheets(y + z - 1).Move before:=Sheets(y)
        Next y
       Next x
       z = z \ 3
    Loop
    Sheets("王6").Select
End Sub

tracy666

666

kasuodx

努力学习... 还有好多不懂..

仰望星光

向高手学习

k新鲜空气k

小白前来学习