' Macro按大小排序情形壹 Macro
'Dim m, n, o, p, q, r, s, t, u, v, w As Long
Dim rng As Range
Dim i, j As Integer
Dim mn As Double
m = Range("A65535").End(xlUp).Row
Cells(1, 2).Value = "公式壹,求位數"
Cells.Replace What:="公式壹,求位數", Replacement:="=len(a1)", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("B1").Select
Selection.AutoFill Destination:=Range("B1:B" & m), Type:=xlFillDefault
Range("B1:B" & m).Select
Columns("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
For o = 1 To m
p = Cells(o, 2).Value
For q = 1 To p
r = Cells(o, 1).Value
r = Left(r, q)
r = Right(r, 1)
Cells(o, q + 4).Value = r
Next
Next
For t = 1 To m
p = Cells(t, 2).Value
Set rng = Range(Cells(t, 5), Cells(t, 5 + p - 1))
For i = 1 To rng.Count
For j = i + 1 To rng.Count
If rng.Cells(j) < rng.Cells(i) Then
mn = rng.Cells(i)
rng.Cells(i) = rng.Cells(j)
rng.Cells(j) = mn
End If
Next
Next
Next
t = 1
For t = 1 To m
p = Cells(t, 2).Value
v = 0
For u = 1 To p
v = v & Cells(t, u + 4)
Next
Cells(t, 3).Value = v
Range(Cells(t, 5), Cells(t, 5 + p)).Clear
Next
Range("b1:b" & m).Clear
Range("b1").Value = "執行結果:"
Dim a, c, d, e As Long
Dim b As Stringa = Range("A65535").End(xlUp).RowFor c = 1 To ad = Len(Cells(c, 1).Text)
b = 0For e = 1 To d - 1
b = 0 & bNextRange("F" & c) = "=TEXT(" & "C" & c & ",""" & b & """)"Next Columns("F:F").Select
Selection.Copy
Columns("C:C").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("F:F").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D1").Select End Sub
Sub 按大小排序情形二()
'
' 按大小排序情形二 Macro
'
'
Dim mm, nn, oo As Long
Dim i, j As Integer
Dim rng As Range
Dim mn As Double
mm = Range("A65535").End(xlUp).Row
For oo = 1 To mm
nn = Application.CountA(Range(oo & ":" & oo))
Set rng = Range(Cells(oo, 1), Cells(oo, nn))
For i = 1 To rng.Count
For j = i + 1 To rng.Count
If rng.Cells(j) < rng.Cells(i) Then
mn = rng.Cells(i)
rng.Cells(i) = rng.Cells(j)
rng.Cells(j) = mn
End If
Next
Next
NextEnd Sub