按部分文本对行组进行sorting
我的数据库输出的数据是以对我无用的方式分类的HTML。 我希望能够在Excel中重新sorting。 问题是双重的：
1）数据一次输出9行，3行标题。 在sorting时，这9行中的每一行都需要保持在一起。
2）主sorting键是其中一个数据单元的SECOND HALF。 在附图中，H14是我需要sorting的位置，包含“3M（WSW）” – 但我不想按“3M”sorting，我想按“（WSW）”sorting。 现在，并不是每个数据元素都有括号中的部分，并且不是每个数据元素在括号之前都有，但括号内的部分是我想要sorting的部分。 二级sorting键将是同一单元格的前半部分，而三级sorting键将是A5，A14等中的部件号
我search谷歌和本网站的帮助，我明白，我可以添加一些额外的列进行sorting（或使一个VBA程序进行sorting，但我没有在VBA编码的东西像15年，现在我不觉得它）。 这个数据库转储有成百上千的logging，所以我需要使用一些公式来创build这些sorting列 – 我无法每周用数百个logging手动执行此操作。 我不知道如何制作公式，将按照我的主要，次要和第三级sorting标准进行sorting，并保持组中的行按原始顺序排列。
经过几天的努力，我得出的结论是，这个任务根本无法做到没有VBA。 因此，我刷了我的VBA（这并不像我想象的那么辛苦），并且写下了下面的代码。
我总结一下，我必须parsing出首字母，parsing品牌名称，获取部件号，获取索引，并将它们混合成一个可以sorting的单个string。 然后，我会拉出索引，并使用它将数据元素复制到sheet2并美化了一下。
Private Sub CommandButton1_Click() Dim iElements As Long Dim vSortKey() As Variant Dim iSortOrder() As Long iElements = 0 ' How Many Part Numbers Were Added? Do Until IsEmpty(Cells(5 + (iElements * 9), 8)) = True iElements = iElements + 1 Loop iElements = iElements - 1 ReDim vSortKey(iElements) ReDim iSortOrder(iElements) '************************* ' Create the Sorting Key. '************************* ' Our Primary Sort is the Initials of the Product Development employee, found in the Parenthesis of Cell H5, and every 9 cells after that ' Our Secondary Sort is the Brand Name, found before the Parenthesis of Cell H5, and every 9 cells after that ' Our Tertiary Sort is the Part Number, found in Cell A5, and every 9 cells after that ' Finally, place the location of the element at the end, so we can find it again on the source sheet. ' Each Key (and the source location) is placed in a single string, and seperated by a colon. ' The Split() command can be used to extract each of these elements from the string, effectively making this a 4D array (index 0 to 3) ' (but a 4D array that's MUCH easier to sort) For i = 0 To iElements vSortKey(i) = FindName(Cells((5 + (i * 9)), 8)) & ":" & FindBrand(Cells((5 + (i * 9)), 8)) & ":" & Cells((5 + (i * 9)), 1) & ":" & i Next i QuickSort vSortKey, 0, iElements ' For convenience, extract the "location" of the sorted elements into a seperate array: iSortOrder() Dim tmp() As String For i = 0 To iElements tmp = Split(vSortKey(i), ":") iSortOrder(i) = CLng(tmp(3)) Next i '***************************************** ' Create the Finished Worksheet on Sheet2 '***************************************** ' Finished Sheet must have a repeating header, borders between elements, and other beautification done ' Note that there are 37 rows to a page, and with 7 rows to an element, 5 will fit per page with 3 rows left for the header. Dim pagecount As Long pagecount = 0 For i = 0 To iElements ' Every five elements is a new page. Every new page, copy the header and update current page count. If (((i + 1) Mod 5) - 1) = 0 Then CopyHeader ((pagecount * 37) + 1) pagecount = pagecount + 1 End If For m = 1 To 16 If (((i + 1) Mod 5) - 1) <> 0 Then Sheet2.Cells((pagecount * 2) + (i * 7), m).Borders(xlEdgeTop).LineStyle = xlContinuous Sheet2.Cells((pagecount * 2) + (i * 7), m).Borders(xlEdgeTop).Weight = xlThin End If For n = 0 To 7 Sheet2.Cells((pagecount * 2) + (i * 7) + n, m) = Sheet1.Cells((5 + (iSortOrder(i) * 9) + n), m) If ((n = 0) Or (n = 2)) Then Sheet2.Cells((pagecount * 2) + (i * 7) + n, 11).NumberFormat = "$#.#0" ElseIf ((n = 1) Or (n = 3)) Then Sheet2.Cells((pagecount * 2) + (i * 7) + n, 11).NumberFormat = "m/d/yyyy" End If Next n Next m Sheet2.Cells((pagecount * 2) + (i * 7), 1).RowHeight = 22.5 Next i End Sub Public Sub CopyHeader(iStart As Long) For i = 1 To 16 Sheet2.Cells(iStart, i) = Sheet1.Cells(1, i) Sheet2.Cells(iStart, i).Borders(xlEdgeBottom).LineStyle = xlContinuous Sheet2.Cells(iStart, i).Borders(xlEdgeBottom).Weight = xlThick Sheet2.Cells(iStart, i).Font.Bold = True Next i End Sub Public Function FindName(vStr As Variant) As Variant Dim StartPos As Long Dim EndPos As Long Dim Length As Long FindName = "" If Len(vStr) > 0 Then StartPos = InStr(vStr, "(") + 1 EndPos = InStr(vStr, ")") Length = EndPos - StartPos If Length <> 0 Then FindName = Mid(vStr, StartPos, EndPos - StartPos) End If End If End Function Public Function FindBrand(vStr As Variant) As Variant Dim Length As Long FindBrand = "" If Len(vStr) > 0 Then Length = InStr(vStr, "(") - 2 If Length > 0 Then FindBrand = Left(vStr, Length) Else FindBrand = vStr End If End If End Function Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long) Dim pivot As Variant Dim tmpSwap As Variant Dim tmpLow As Long Dim tmpHi As Long tmpLow = inLow tmpHi = inHi pivot = vArray((inLow + inHi) \ 2) While (tmpLow <= tmpHi) While (vArray(tmpLow) < pivot And tmpLow < inHi) tmpLow = tmpLow + 1 Wend While (pivot < vArray(tmpHi) And tmpHi > inLow) tmpHi = tmpHi - 1 Wend If (tmpLow <= tmpHi) Then tmpSwap = vArray(tmpLow) vArray(tmpLow) = vArray(tmpHi) vArray(tmpHi) = tmpSwap tmpLow = tmpLow + 1 tmpHi = tmpHi - 1 End If Wend If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi End Sub