VBA：sorting收集

以下代码从B6：E6范围提取＆格式化值，然后将它们存储在variables中。 之后，该例程按升序对4个variables的集合进行sorting。 当它们被sorting时，它们被放入范围L31：O31。

问题是，如果selectless于4个variables ，比如说3，那么程序将跳过L31单元格，并将其余部分放到M31：O31。 同时inputL31：N31，O31 – 空白。

如果集合中的variablesless于4个，代码如何修改以满足从L31开始的数据？

Function ExtractKey(s As Variant) As Long Dim v As Variant, n As Long v = Trim(s) 'remove spaces leave only spaces between words If v Like "*(*)" Then 'if it's SOPXX (YYYY) then n = Len(v) 'find number of the characters If n = 11 Then v = Mid(v, n - 7, 7) 'find the number of SOP + year in bracket ElseIf n = 12 Then v = Mid(v, n - 8, 8) End If v = Replace(v, "(", "") 'replace the brackets with nothing v = Replace(v, " ", "") 'SOP10 (2015) doesn't have to go first before SOP12 (2014); switch figures If n = 11 Then v = Right(v, 4) + Left(v, 1) ElseIf n = 12 Then v = Right(v, 4) + Left(v, 2) End If ExtractKey = CLng(v) Else ExtractKey = 0 End If End Function Sub Worksheet_Delta_Update() Dim SourceRange As Range, TargetRange As Range Dim i As Long, j As Long, minKey As Long, minAt As Long Dim v As Variant Dim C As New Collection Set SourceRange = Worksheets("t").Range("B6:E6") Set TargetRange = Worksheets("x").Range("L31:O31") For i = 1 To 4 v = SourceRange.Cells(1, i).Value C.Add Array(ExtractKey(v), v) Next i 'transfer data For i = 1 To 4 minAt = -1 For j = 1 To C.Count If minAt = -1 Or C(j)(0) < minKey Then minKey = C(j)(0) minAt = j End If Next j TargetRange.Cells(1, i).Value = C(minAt)(1) C.Remove minAt Next i End Sub 

Answer 1

当值插入到TargetRange时，可以添加一个variables，例如col ，代替variablesi 。 这个variables的工作原理与i工作的一样，但是只有插入的值不为空时才会增加。 HTH

  'transfer data Dim col As Integer col = 1 For i = 1 To 4 minAt = -1 For j = 1 To C.Count If minAt = -1 Or C(j)(0) < minKey Then minKey = C(j)(0) minAt = j End If Next j If (C(minAt)(1) <> "") Then TargetRange.Cells(1, col).Value = C(minAt)(1) col = col + 1 End If C.Remove minAt Next i