 |
สืบเนื่องจากการจัดเรียงกระทู้ตามจำนวนความคิดเห็น{แตกประเด็นจาก X4668768}
สามารถจัดเรียงได้ทั้งหมด 1000 กระทู้ในคราวเดียวกัน
ครับ ขั้นแรกใช้ mouse เลือกบริเวณกระทู้ แล้วกดปุ่มใน
โปรแกรมเพื่อจัดเรียง
Dim Item(1 To 1000) As String
Dim NItem(1 To 1000) As Integer
Private Sub CommandButton1_Click()
UserForm1.Label1.Caption = "Copying..."
UserForm1.Repaint
ActiveSheet.Name = "Sorted"
NameNow = ActiveSheet.Name
Sheets(NameNow).Cells.Clear
Sheets(NameNow).Cells(1, 1).Select
Sheets(NameNow).Paste
Sheets(NameNow).Cells(1, 2).Select
Range(Sheets(NameNow).Cells(1, 1), Sheets(NameNow).Cells(65536, 1)).UnMerge
N = Sheets(NameNow).Shapes.Count
If N = 0 Then GoTo 1:
For i = 1 To N
Sheets(NameNow).Shapes("Picture " & i).Delete
Next i
1:
For k = 1 To 1000
If Trim(Sheets(NameNow).Cells(k, 1)) = "" And Sheets(NameNow).Cells(k, 2) <> "" Then
Sheets(NameNow).Cells(k, 1).Delete Shift:=xlToLeft
End If
If Sheets(NameNow).Cells(k, 1) = "" And Sheets(NameNow).Cells(k, 2) = "" Then Sheets(NameNow).Cells(k, 1).EntireRow.Delete
UserForm1.Label1.Caption = "µÃǨÊͺÃͺ·Õè 1 ºÃ÷Ѵ·Õè " & k
UserForm1.Repaint
Next k
For k = 1 To 1000
If Sheets(NameNow).Cells(k, 1) = "" Then
Sheets(NameNow).Cells(k, 1).Delete Shift:=xlToLeft
UserForm1.Label1.Caption = "µÃǨÊͺÃͺ·Õè 2 ºÃ÷Ѵ·Õè " & k
UserForm1.Repaint
End If
Next k
For k = 1 To 1000
If Cells(k, 1) <> "" Then
Item(k) = Sheets(NameNow).Cells(k, 1)
A1 = InStrRev(Item(k), "(")
A2 = InStrRev(Item(k), " - ")
NNN = Mid(Item(k), A1 + 1, A2 - A1)
NItem(k) = CInt(NNN)
Cells(k, 2) = NItem(k)
UserForm1.Label1.Caption = "ÇÔà¤ÃÒÐËì¨Ó¹Ç¹¤ÇÒÁ¤Ô´àËç¹ã¹ºÃ÷Ѵ·Õè " & k
UserForm1.Repaint
End If
Next k
Columns("A:A").ColumnWidth = 150
Range(Sheets(NameNow).Cells(1, 1), Sheets(NameNow).Cells(65536, 1)).RowHeight = 15
Range(Cells(1, 1), Cells(1000, 2)).Select
Selection.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets(NameNow).Cells(1, 2).Select
End Sub
Sub Userform_initialize()
UserForm1.Label1.Caption = ""
End Sub
จากคุณ :
Practical x 2  
- [
30 ส.ค. 49 22:32:00
]
|
|
|
|
|
|
