當前位置:成語大全網 - 新華字典 - 請專家用vba幫忙按大小排序

請專家用vba幫忙按大小排序

Sub 按大小排序情形壹()'

' 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