计算Excel VB数组列中非空字段的数量

我目前在一个Excel VBA数组中读取一个2维范围,如下所示:

Set Ws = Sheet1 Ws.Activate LastRow = Ws.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row LastCol = Ws.Cells.Find("*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column ReDim elements(0 To LastRow - 2, 0 To LastCol - 2) elements = Ws.Range(Cells(2, 1), Cells(LastRow, LastCol)) 

范围是25行×11列。 但是,并不是所有单元格都有值,所以数组中的某些值是“空的”。

  • col A有25个项目
  • col B有16个
  • col K有12 …

我需要遍历这个数组并创build第二个数组,这将是第一个数值“笛卡尔乘积” 。 为了确定我需要循环多less次,我需要计算出每个数组列(“维度”?)中有多less个项目。

这是我的循环尝试:

 Row = 0 For i = 1 To 25 'numElements in column 1 For j = 1 To 3 'numElements in column 6 For k = 1 To 5 'numElements in column 7 For l = 1 To 14 'numElements in column 8 For m = 1 To 6 'numElements in column 10 For n = 1 To 12 'numElements in column 11 cartesian(Row, 0) = elements(i, 0) cartesian(Row, 1) = elements(i, 1) cartesian(Row, 2) = elements(i, 2) cartesian(Row, 3) = elements(i, 3) cartesian(Row, 4) = elements(i, 4) cartesian(Row, 5) = elements(j, 5) cartesian(Row, 6) = elements(k, 6) cartesian(Row, 7) = elements(l, 7) cartesian(Row, 8) = elements(l, 8) cartesian(Row, 9) = elements(m, 9) cartesian(Row, 10) = elements(n, 10) Row = Row + 1 Next n Next m Next l Next k Next j Next i 

任何帮助赞赏:)

编辑1:

这是我读入array1的范围:

 Austria sem jan Belgium gdn feb France mar US apr may jun 

我需要能够计算第1列,第2列和第3列中有多less“项目”,以便将它们相乘。 这样我就会知道我需要多大的ReDim第二个数组。

这是我需要在数组2中,并最终写回到另一个表:

 Austria sem jan Austria sem feb Austria sem mar Austria sem apr Austria sem may Austria sem jun Austria gdn jan Austria gdn feb Austria gdn mar Austria gdn apr Austria gdn may Austria gdn jun Belgium sem jan Belgium sem feb Belgium sem mar Belgium sem apr Belgium sem may Belgium sem jun Belgium gdn jan Belgium gdn feb Belgium gdn mar Belgium gdn apr Belgium gdn may Belgium gdn jun 

等等

这应该就像你需要它在一个相当的时间…仍然需要一些时间〜约30万条目:

 Option Explicit Sub getMyList() 'set input Dim inputVal As Variant 'get input values With ThisWorkbook.Worksheets("Sheet1") inputVal = .Range(.Cells(1, 1), .Cells(.Cells.Find("*", , , , 1, 2).Row, .Cells(1, 1).End(xlToRight).Column)).Value End With 'set count array Dim xCounts() As Variant ReDim xCounts(1 To UBound(inputVal, 2)) Dim i As Long, j As Long For i = 1 To UBound(xCounts) j = 1 While inputVal(j, i) <> "" And j < UBound(inputVal) j = j + 1 Wend 'xCounts(i) = j - 1 'will skip last value if it is at the last row xCounts(i) = j + (inputVal(j, i) = "") 'new one will work as wanted Next 'set output sizes Dim outVal() As Variant ReDim outVal(1 To Application.Product(xCounts), 1 To UBound(xCounts)) 'runner sets Dim colRunner As Long, rowRunner As Long, copyRunner As Long Dim itemRep As Long, listRep As Long For colRunner = 1 To UBound(xCounts) rowRunner = 1 itemRep = 1 listRep = 1 'repeat whole list For i = 1 To colRunner - 1 listRep = listRep * xCounts(i) Next 'repeat each item For i = colRunner + 1 To UBound(xCounts) itemRep = itemRep * xCounts(i) Next 'run the list for output copyRunner = 1 For i = 1 To listRep For copyRunner = 1 To xCounts(colRunner) For j = 1 To itemRep outVal(rowRunner, colRunner) = inputVal(copyRunner, colRunner) rowRunner = rowRunner + 1 Next Next Next Next 'output everything ThisWorkbook.Worksheets("Sheet2").Cells(1, 1).Resize(UBound(outVal), UBound(outVal, 2)).Value = outVal End Sub 

代码应该很容易阅读(里面没有真正的魔法):P

但是,如果有任何问题,只要问:)

编辑

xCounter只保存每列的所有项目的计数,因为这个数字被使用很多次。
澄清:让我们假设你有一个这样的列表:

 ABCDE 1 1 1 1 1 2 2 2 2 2 3 3 3 3 4 4 4 5 5 5 6 6 6 7 7 8 

(用于易于计数的数字,也适用于任何string)
xCounter现在将是{8,2,6,7,3} 。 现在,如果你想写下列C,那么你需要知道每个项目需要重复多less次。 这可以通过乘以后面所有列的计数来计算。 对于这种情况,它将是7 * 3 = 21次。 此外,你需要知道列表中有多less项目,以循环通过哪些将是6 。 那么整个列表也需要重复,可以通过乘以前面的所有行数来计算。 那将是8 * 2 = 16次。 通过这种方式也可以build立3个内部For ... Next循环。 ListRepeat(EachItem(ItemRepeat)) 。 要知道输出数组中的哪一行将被写入,您需要一个简单的向上计数值,即RowCounter 。 直接在表单中进行操作时,每使用一个单元格写入一个值,就会使用一个简单的偏移一行的范围。
通过这个系统,你可以将每一列与其他列完全分开,因为你所需要的只是前面和后面列(我们有xCounter)的项目计数的结果。 我们仍然需要为每列执行此操作,所以外部循环是列(colRunner)。
简单地说,为了不让使用i, j, k, l 4个循环相互混淆,我将outVal的行重新命名为outVal ,将列中的outValrowRunnercolRunner 。 有重复直接设置在内部循环前面的上限和下限,我留在ij 。 (也不用于循环中的任何事情,他们只是通过多次执行相同的操作来确保重复)

如果我错过了一些其他问题或者其他问题,那就做吧,因为总是这样做:问。 ;)