VBA：排序集合

Question

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

问题是，如果有较少的比4个变量选择，说3，例程将跳过L31细胞，并把其余的M31：O31。它应该输入为L31：N31，而O31 - 为空白。

如果代码中的变量少于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中时，将使用它将代替变量i。该变量的工作方式与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