我使用底部的代码按字母顺序，数字地以及以下字母和标点字符（AB00017C）对列进行排序。在我正在研究的单一列表上，生活是美好的。只要数据在A列中，一切看起来都很棒。
当我移动到包含多个列的工作表时，它很简单！
我花了两天时间让这种方式起作用。它在A列的右侧插入3个辅助列，将单元格值从A列切割为三个新列，然后按正确顺序对它们进行排序。最后，它删除了3个辅助列。
我已将代码附加到一个简单的命令按钮进行测试。对不起，论坛已经删除了所有评论。
我的表格列在CG栏目中，这个子程序非常有用。
现在我的头疼了，我想我已经把自己编程到一个角落而且我不知道如何离开。
任何见解都会受到热烈欢迎，CraigMc
以下是一些数据
sku post_title
AB00017a Lixit, Glass Water Bottle, 32 oz.
AB00017 Lixit, Glass Water Bottle, 16 oz.
AB00016z Hookbill Legume Blend with Peantus, 32 lbs.
AB00016-b Bonito Loco Pretty Crazy Nut Blend, 32 lbs.
AB00016 Madagascar Delite, 64 oz.
AB00017c Nutmeats and Fruit, 32 lbs.
AB00017g Nutmeats and Fruit, 25 oz.
以下是代码：
Private Sub CommandButton1_Click()
Dim intLoops As Integer
Dim lngNumeric As Long
Dim lngLastRow As Long
Dim rngRows As Range
Dim rngcell As Range
Dim strAlpha As String
Dim strPrefix As String
Dim strSuffix As String
'-----------------------------
strPrefix = "True"
strSuffix = "False"
'-----------------------------
Columns("B:D").Insert Shift:=xlToRight 'Insert 3 temporary columns to the Right of Column A.
lngLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, Left("A1", 1)).End(xlUp).Row
Set rngRows = Range("A2", Range("A" & Rows.Count).End(xlUp)) 'Separates Alpha to Next Column, Numeric to the following column
For Each rngcell In rngRows
intLoops = Len(rngcell) 'Works on one character at at time.
For intLoops = 1 To intLoops 'Read each character in the cell
If strPrefix = "True" Then
If Not IsNumeric(Mid(rngcell, intLoops, 1)) Then 'This is the PREFIX
strAlpha = strAlpha & Mid(rngcell, intLoops, 1)
If IsNumeric(Mid(rngcell, intLoops + 1, 1)) Then 'Is the next character Aphabetic, Yes this is the SUFFIX coming up.
strPrefix = "False" 'Next Charater is the Suffix
End If
Else
lngNumeric = lngNumeric & Mid(rngcell, intLoops, 1) 'No it is the number in the middle
End If
Else 'This is the Suffix
If IsNumeric(Mid(rngcell, intLoops, 1)) And strSuffix = "False" Then
lngNumeric = lngNumeric & Mid(rngcell, intLoops, 1) 'No it is the number in the middle
If (Mid(rngcell, intLoops + 1, 1)) = "-" Then 'Onceyou hit a non-numeric character stay in the suffix.
strSuffix = "True" 'Ensures that all that follows the center number stays in the Suffix.
End If
Else
alpSuffix = alpSuffix & Mid(rngcell, intLoops, 1) 'Character SUFFIX
End If
End If
Next intLoops
rngcell.Offset(, 1) = strAlpha
rngcell.Offset(, 2) = lngNumeric
rngcell.Offset(, 3) = alpSuffix & " "
strAlpha = vbNullString
lngNumeric = 0
alpSuffix = vbNullString
strPrefix = "True"
strSuffix = "False"
Next rngcell
Set rngRows = rngRows.Resize(rngRows.Rows.Count, 4)
rngRows.Sort key1:=rngRows.Range(Cells(1, 3), Cells(rngRows.Rows.Count, 3)), order1:=xlAscending, _
key2:=rngRows.Range(Cells(1, 2), Cells(rngRows.Rows.Count, 2)), order2:=xlAscending, Header:=xlGuess
lngLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, Left("A2", 1)).End(xlUp).Row
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Range("B1"), xlSortOnValues, xlAscending
ActiveSheet.Sort.SortFields.Add Range("C1"), xlSortOnValues, xlAscending
ActiveSheet.Sort.SortFields.Add Range("D1"), xlSortOnValues, xlAscending
With ActiveSheet.Sort
.SetRange Range("A1").CurrentRegion
.Header = xlYes
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("B:D").Delete Shift:=xlToLeft 'Delete the 3 temporary columns to the Right of Column A.
End Sub
谢谢！
答案 0 :(得分：0)
我做了一些修改以解决范围问题，但是字符串的解析效果很好
我的更改：
将大部分变量重命名为更直观
通过
减少与工作表对象的交互使用算法解析字符串
将内存中的数据放回到工作表中，一次
将排序应用于工作表上的所有数据（您的排序区域设置不正确）
以下是更新后的代码，请将其放入新模块
if (true) {
...
}
function doSomething() {
...
}
将此功能放在同一个（新）模块中
public class Test extends Thread{
@override
public void run(){
//do something
}
public void run(int i){
//do something
}
public static void main(String[] args) {
Test test=new Test();
// test.start()
// How Can I let the two run() methods run in different thread?
}
}
您可以从任何Sheet模块调用main函数，如下所示：
Option Explicit
'Place the code in a new module (from the menu: Insert -> Module)
Private Const START_COL As Byte = 1
Public Sub SortSheet(ByVal wsName As String, _
Optional ByVal sortCol As Long = 1, _
Optional ByVal row1 As Long = 2)
Dim wb As Workbook: Dim ws As Worksheet
Dim lRow As Long: Dim lCol As Long
Dim thisRow As Long: Dim thisStr As String
Dim lastCell As Range
Dim sortRng As Range: Dim sortKey1 As Range
Dim sortKey2 As Range: Dim sortKey3 As Range
Dim memArr1Col As Variant 'column with strings (in memory)
Dim memArr3Col As Variant 'helper columns, for sorting (in memory)
Dim char As Long: Dim strLen As Long
Dim preBol As Boolean: Dim sufBol As Boolean
Dim midNum As String
Dim preStr As String: Dim sufStr As String
'---------------------------------------
preBol = True
sufBol = False
'---------------------------------------
With Application
.ScreenUpdating = False
Set wb = .ActiveWorkbook
End With
Set ws = Sheets(wsName)
Set lastCell = GetMaxCell(ws.UsedRange)
lRow = lastCell.Row
lCol = lastCell.Column
If row1 <= lRow Then
With ws 'set mem arrays: sort col, and helpers
memArr1Col = .Range(.Cells(row1, sortCol), .Cells(lRow, sortCol))
memArr3Col = .Range(.Cells(row1, lCol + 1), .Cells(lRow, lCol + 3))
End With
For thisRow = row1 - 1 To lRow - 1 'parse each cell in sort column
If Not IsEmpty(memArr1Col(thisRow, 1)) And _
Not IsNull(memArr1Col(thisRow, 1)) And _
Len(memArr1Col(thisRow, 1)) > 0 Then
thisStr = memArr1Col(thisRow, 1)
strLen = Len(thisStr)
For char = 1 To strLen 'parse each string
If preBol = True Then
If Not IsNumeric(Mid(thisStr, char, 1)) Then
preStr = preStr & Mid(thisStr, char, 1)
preBol = Not IsNumeric(Mid(thisStr, char + 1, 1))
Else
midNum = midNum & Mid(thisStr, char, 1)
End If
Else
If IsNumeric(Mid(thisStr, char, 1)) And sufBol = False Then
midNum = midNum & Mid(thisStr, char, 1)
sufBol = (Mid(thisStr, char + 1, 1)) = "-"
Else
sufStr = sufStr & Mid(thisStr, char, 1)
End If
End If
Next 'Next character in the string
memArr3Col(thisRow, 1) = preStr
memArr3Col(thisRow, 2) = midNum
memArr3Col(thisRow, 3) = sufStr & " "
preBol = True
sufBol = False
midNum = vbNullString
preStr = vbNullString
sufStr = vbNullString
End If
Next 'Next Row
With ws
'place helper column values from memory to current worksheet
.Range(.Cells(row1, lCol + 1), .Cells(lRow, lCol + 3)) = memArr3Col
'set sort range - all data on this sheet plus the last 3 helper columns
Set sortRng = .Range(.Cells(row1, START_COL), .Cells(lRow, lCol + 3))
'set sort keys to helper columns
Set sortKey1 = .Range(.Cells(row1, lCol + 1), .Cells(lRow, lCol + 1))
Set sortKey2 = .Range(.Cells(row1, lCol + 2), .Cells(lRow, lCol + 2))
Set sortKey3 = .Range(.Cells(row1, lCol + 3), .Cells(lRow, lCol + 3))
End With
With ws
With .Sort 'apply the sort
With .SortFields
.Clear
.Add sortKey1, xlSortOnValues, xlAscending
.Add sortKey2, xlSortOnValues, xlAscending
.Add sortKey3, xlSortOnValues, xlAscending
End With
.SetRange sortRng
.Header = xlYes
.Orientation = xlTopToBottom
.Apply
End With
.Range( _
.Cells(row1, lCol + 1), _
.Cells(lRow, lCol + 3)).EntireColumn.Delete 'delete helper cols
.Activate
.Cells(1, 1).Activate
End With
End If
Application.ScreenUpdating = True
End Sub
或者像这样（覆盖默认参数）
Public Function GetMaxCell(Optional ByRef rng As Range = Nothing) As Range
'Returns the last cell of range with data, or A1 if Worksheet is empty
Const NONEMPTY As String = "*"
Dim lRow As Range, lCol As Range
If rng Is Nothing Then Set rng = Application.ActiveWorkbook.ActiveSheet.UsedRange
If WorksheetFunction.CountA(rng) = 0 Then
Set GetMaxCell = rng.Parent.Cells(1, 1)
Else
With rng
Set lRow = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
After:=.Cells(1, 1), _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows)
If Not lRow Is Nothing Then
Set lCol = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
After:=.Cells(1, 1), _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns)
Set GetMaxCell = .Parent.Cells(lRow.Row, lCol.Column)
End If
End With
End If
End Function
要更改排序键，请相应地修改以下3行：
对 PreFix （第一个辅助列，然后是第2个，然后是第3个）进行排序：
Option Explicit
Private Sub CommandButton1_Click()
SortSheet wsName:="Master of Masters"
End Sub
要排序中间身份号码（第二个辅助列，然后是第1个，然后是第3个）：
Option Explicit
Private Sub CommandButton1_Click()
SortSheet wsName:="Master of Masters", sortCol:=1, row1:=2
End Sub
要排序 PostFix （第三个辅助列，然后是第二个，然后是第三个）：
Set sortKey1 = .Range(.Cells(row1, lCol + 1), .Cells(lRow, lCol + 1)) 'PreFix: "AB"
Set sortKey2 = .Range(.Cells(row1, lCol + 2), .Cells(lRow, lCol + 2)) 'Middle ID
Set sortKey3 = .Range(.Cells(row1, lCol + 3), .Cells(lRow, lCol + 3)) 'PostFix
我使用您提供的数据对其进行了测试。结果如下：
{{0}}
排序期间 - 说明解析3个帮助列中字符串的结果
{{0}}