VBA - 嵌套循环索引 i 组中的 j 项

Question

我有组（从 1, 2 ... 到 i），每组包含 j 个项目。

我想为每个项目建立索引（从1,2,3,4 ...一直到最后）。

喜欢：

我	j	索引
1	1	1
1	2	2
1	3	3
2	1	4
2	2	5
3	1	6
3	2	7
3	3	8
3	4	9

我认为我可以用嵌套的 for 循环来做到这一点（For i = 1 to ... For j = 1 to ...），但事实证明用 (i,j) 来制定每个项目的索引之间的关系似乎困难。

有人可以帮忙吗？

我尝试了不同的公式：

index  = j + (i-1) * j
index = j + i*(j-1)

... 某种程度，但他们失败了。

Answer 1

请尝试下一个版本。它使用 Scriptinig

Dictionary

，将项目加载为键，将索引加载为项目。

它能够完成这项工作即使项目没有按字母顺序排序！我的意思是，它可以是 1, 1, 3, 1, 2, 2 等等，而不是 1, 1, 1, 2, 2 等等...

它会在不同的范围内返回，即使对于很大的范围，速度也非常快。如果所有项目都已排序，您可以使用仅一列的数组（arrFin）...

Sub IndexItems()
  Dim ws As Worksheet, lastR As Long, arr, arrIt, arrFin, i As Long, dict As Object
  
  Set ws = ActiveSheet
  lastR = ws.Range("A" & ws.rows.Count).End(xlUp).row
  
  arr = ws.Range("A2:A" & lastR).Value2 'place the range in an array for faster procerssing
  Set dict = CreateObject("Scripting.Dictionary") 'set the necesssary dictionary
  'iterate between the array rows and load the necessary data
  For i = 1 To UBound(arr)
    If Not dict.Exists(arr(i, 1)) Then
        dict.Add arr(i, 1), Array(1)
    Else
        arrIt = dict(arr(i, 1)) 'extract the item array
        ReDim Preserve arrIt(UBound(arrIt) + 1) 'redim it with an element
        arrIt(UBound(arrIt)) = arrIt(UBound(arrIt) - 1) + 1 'Place as the last element the previous
                                                            'one plus a unit
        dict(arr(i, 1)) = arrIt 'place back the array
    End If
  Next i
  
  'Process the dictionary data and place them in the final array
  ReDim arrFin(1 To UBound(arr), 1 To 2) ' Make place for the necessary data:
  Dim countEl As Long, j As Long, k As Long
  For i = 0 To dict.Count - 1
    countEl = UBound(dict.Items()(i)) + 1 'the number of dictionary item array elements
                                          '(+ 1 because it is a1D array)
    For j = 1 To countEl
        k = k + 1
        arrFin(k, 1) = dict.keys()(i): arrFin(k, 2) = dict.Items()(i)(j - 1)
    Next j
  Next i
  
  'drop the array content, at once:
  ws.Range("E2").Resize(UBound(arrFin), UBound(arrFin, 2)).Value2 = arrFin
End Sub

简单的方法，仅处理已排序的项目：

Sub SimpleIndexItems()
  Dim ws As Worksheet, lastR As Long, arr, arrFin, i As Long, iCount As Long
  
  Set ws = ActiveSheet
  lastR = ws.Range("A" & ws.rows.count).End(xlUp).row
  
  arr = ws.Range("A2:A" & lastR).Value2 'place the range in an array for faster procerssing
  ReDim arrFin(1 To UBound(arr), 1 To 1)
  For i = 2 To UBound(arr)
    If arr(i, 1) = arr(i - 1, 1) Then
        iCount = iCount + 1       'increment the count variable
        arrFin(i - 1, 1) = iCount 'place it in the arrFin if identic with the above value
        If i = UBound(arr) Then arrFin(i, 1) = iCount + 1 'only for the last array element...
    Else
        arrFin(i - 1, 1) = iCount + 1: iCount = 0 'place the count and reset the variable
    End If
  Next i
  
  'drop the array content, at once:
  ws.Range("B2").Resize(UBound(arrFin), UBound(arrFin, 2)).Value2 = arrFin
End Sub