Excel2003代码问题，非常感谢！

LSYYLW

2019-12-30.zip (9.27 KB, 下载次数: 4)

2019-12-29 19:41 上传

点击文件名下载附件

一把小刀闯天下

Option Explicit

Private Sub CommandButton1_Click()
  Dim arr, i, j, t
  arr = Range("b1:b" & [b1].End(xlDown).Row)
  For i = 1 To UBound(arr, 1) - 1
    For j = i + 1 To UBound(arr, 1)
      If arr(i, 1) > arr(j, 1) Then
        t = arr(i, 1): arr(i, 1) = arr(j, 1): arr(j, 1) = t
      End If
    Next
  Next
  [b1].Resize(UBound(arr, 1)) = arr
End Sub

Private Sub CommandButton2_Click()
  [a:a].ClearContents
End Sub

网海遨游

手机回复，未调试。试试以下代码，若有问题，我明天上班再调试下。
sub test()
r=cells(rows.count,2).end(3).row
arr=range("b1:b" & r)
for i=1 to r
for j=i+1 to r
if arr(i,1)<arr(j,1) then'改变<符号为>符告，排序也会改变。
a=arr(i,1):arr(i,1)=arr(j,1):arr(j,1)=a
end if
next j
next i
[b:b].clearcontents
[b1].resize(r)=arr

tigertc

Private Sub CommandButton1_Click()
Range("B1:B" & [B65536].End(3).Row).Sort key1:=[B1], ORDER1:=xlAscending, Header:=xlNo
End Sub


Private Sub CommandButton2_Click()
Columns(1).ClearContents
End Sub

LSYYLW

tigertc 发表于 2019-12-29 20:17
Private Sub CommandButton1_Click()
Range("B1:B" & .End(3).Row).Sort key1:=, ORDER1:=xlAscending, He ...

万分的感谢老师，代码非常好用。鲜花明天一定为您补上。

LSYYLW

一把小刀闯天下 发表于 2019-12-29 20:08
Option Explicit

Private Sub CommandButton1_Click()

万分的感谢老师，代码非常好用。鲜花明天为您献上。

LSYYLW

网海遨游 发表于 2019-12-29 20:14
手机回复，未调试。试试以下代码，若有问题，我明天上班再调试下。
sub test()
r=cells(rows.count,2).en ...

非常感谢老师，代码没有成功，您有时间再帮我看。

LSYYLW

2019-12-30----.zip (10.4 KB, 下载次数: 3)

2019-12-29 21:09 上传

点击文件名下载附件

LSYYLW

tigertc 发表于 2019-12-29 20:17
Private Sub CommandButton1_Click()
Range("B1:B" & .End(3).Row).Sort key1:=, ORDER1:=xlAscending, He ...

抱歉老师，提问题时没有考虑周全，我又修改了条件，您有时间帮我看一下8楼附件里的问题，拜托了！

一把小刀闯天下

Option Explicit

Private Sub CommandButton1_Click()
  Dim arr, i
  arr = Range("b1:b" & [b1].End(xlDown).Row)
  For i = 1 To UBound(arr, 1)
    arr(i, 1) = i
  Next
  [b1].Resize(UBound(arr, 1)) = arr
End Sub

Private Sub CommandButton2_Click()
  [a:a].ClearContents
End Sub