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