请专家用vba帮忙按大小排序情形一：原表排序后表A列A列第1行120第1行012第2行210第2行012第3行132第3行123第4行121第4行112第5行221第5行122第6行020第6行002第7行100第7行001第8行211第8行112第9行000

Question

请专家用vba帮忙按大小排序情形一：原表排序后表　A列　A列第1行120第1行012第2行210第2行012第3行132第3行123第4行121第4行112第5行221第5行122第6行020第6行002第7行100第7行001第8行211第8行112第9行000第9行000第10行111第10行111第11行666第11行666情形二：原表排序后表或排序后表　A列B列C列　A列B列C列　A列第1行120第1行012第1行012第2行210第2行012第2行012第3行132第3行123第3行123第4行121第4行112第4行112第5行221第5行122第5行122第6行020第6行002第6行002第7行100第7行001第7行001第8行211第8行112第8行112第9行000第9行000第9行000第10行111第10行111第10行111第11行666第11行666第11行666

Answer 1

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