VBA：重新排列并将数组导出到Excel工作表

我的问题如下：

• 表A在第一列中的typesX的数字之后进行sorting; 在每一行中，几个types的数字Y可以与一个typesX的数字相关联; typesY的数字可以与不同数量的typesX相关联

• 我的目标是对表格进行sorting，以便最终得到一个新的表格，显示与任何一个Ytypes相关的所有X型数字; （当然可能有几个与Y型连接的X型号）

• 在C＃和Java中我只有一些基本的经验，但是在VBA中没有任何东西，但是我提出了一些代码，如果不是关于variables的不匹配types和单元格的不正确索引的错误消息的话，

• 基本上我想要做的是对整个表进行sorting，并查看是否有任何types为Y的条目用于数字typesX，如果是，则将该X写入到一个新表格中，

我开始相当乐观，但是对于语法以及网上不同的代码样本，有太多的未知数来实现特定的步骤，以便我有效地处理它们。

有谁能给我一些build议吗？ 这个想法本身很简单。

也许将重新排列的条目先转换到另一个数组，然后再将其写回到Excel工作表中可能是更好的方法。

Sub Makro() Dim myArr As Variant Dim myRow1 As Long Dim myRow2 As Long Dim myCol2 As Long Dim eqNo As Long Dim Destination As Range myRow1 = 1 myRow2 = 1 myCol2 = 2 eqNo = 10000000 myArr = Array(Sheets("MAT-EQ KUT").Range("C5:J1594").value) Sheets("Tabelle1").Activate Set Destination = Array(Sheets("Tabelle1").Range("A1").Resize(1801, 1590).value) = myArr ActiveSheet.Unprotect With Sheets("Tabelle1") For myRow2 = 1 To 1801 myCol2 = 2 Sheets("Tabelle1").Cells(myRow2, 1) = eqNo For myRow1 = 1 To 1590 If myArr(myRow1, 2) = eqNo Then Sheets("Tabelle1").Cells(myRow2, myCol2) = myArr(myRow1, 1) ElseIf myArr(myRow1, 3) = eqNo Then Sheets("Tabelle1").Cells(myRow2, myCol2 + 1) = myArr(myRow1, 1) ElseIf myArr(myRow1, 4) = eqNo Then Sheets("Tabelle1").Cells(myRow2, myCol2 + 2) = myArr(myRow1, 1) ElseIf myArr(myRow1, 5) = eqNo Then Sheets("Tabelle1").Cells(myRow2, myCol2 + 3) = myArr(myRow1, 1) ElseIf myArr(myRow1, 6) = eqNo Then Sheets("Tabelle1").Cells(myRow2, myCol2 + 4) = myArr(myRow1, 1) ElseIf myArr(myRow1, 7) = eqNo Then Sheets("Tabelle1").Cells(myRow2, myCol2 + 5) = myArr(myRow1, 1) ElseIf myArr(myRow1, 8) = eqNo Then Sheets("Tabelle1").Cells(myRow2, myCol2 + 6) = myArr(myRow1, 1) End If myCol2 = myCol2 + 7 Next myRow1 eqNo = eqNo + 1 Next myRow2 End With ActiveSheet.Protect End Sub 

Answer 1

Range.Value包含多个单元格，则它将返回一个二维数组，并且您的嵌套循环假定它有两个维度。 但是，当您将一个multidimensional array传递给Array() ，它会将其展平为一维：

 myArr = Array(Sheets("MAT-EQ KUT").Range("C5:J1594").Value) Debug.Print UBound(myArr, 1) 'Prints 10289 (8 columns * 1590 rows) Debug.Print UBound(myArr, 2) 'Subscript error. 

它应该是简单的：

 myArr = Sheets("MAT-EQ KUT").Range("C5:J1594").Value 

下一个问题是这一行：

 Set Destination = Array(Sheets("Tabelle1").Range("A1").Resize(1801, 1590).Value) = myArr 

说实话，我不知道这个代码应该做什么 – Destination从来没有在任何地方使用。 当你使用=两次时，编译器试图做的是在Destination存储一个对象引用。 但expression式的右侧被视为Boolean 。 这有两个问题。 首先，VBA不能像这样testing两个数组的权限（它引发types不匹配） – 您需要循环遍历元素。 其次，即使可以 ，expression式也会返回一个Boolean ，不能用Set赋值给一个对象。

我没有得到更多的东西，但还有其他的一些事情要提到：

• 您不需要初始化myRow1 ， myRow2或myCol2 。 For myRow1 = {#} To ...它们初始化为任何#是。
• 当您在“ With Sheets("Tabelle1")的行上创buildWith Sheets("Tabelle1")块时，可以省略块内部各处的Sheets("Tabelle1") 。 即， .Cells(myRow2, myCol2) = myArr(myRow1, 1)而不是Sheets("Tabelle1").Cells(myRow2, myCol2) = myArr(myRow1, 1)

Answer 2

我认为包含我用于validation代码的testing会很有趣。

在Makro中，所有的数据都被加载到数组中并被处理。 数据然后被写回原始范围。

testing

 Sub TestMakro() Dim Start With Worksheets.Add .Name = "Tabelle1" .Range("A1") = 1 .Range("A1").DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _ Step:=1, Stop:=1801, Trend:=False End With Start = Timer With Worksheets.Add .Name = "MAT-EQ KUT" .Range("C5:J1594").Formula = "=INT(RAND()*1500)" .Range("C5:J1594").value = .Range("C5:J1594").value .Range("C5:J5").value = Array(True, 2, 3, 4, 5, 6, 7, 8) End With Call Makro Debug.Print "Time in Seconds: "; Timer - Start End Sub 

万客隆

 Sub Makro() Dim x As Long, x1 As Long, y As Long, y1 As Long Dim arMAT, arTAB arMAT = Sheets("MAT-EQ KUT").Range("C5:J1594").value Sheets("Tabelle1").Range("B1").Resize(1801, 1589).ClearContents arTAB = Sheets("Tabelle1").Range("A1").Resize(1801, 1590).value For x = 1 To UBound(arTAB, 1) For x1 = 1 To UBound(arMAT, 1) For y1 = 2 To UBound(arMAT, 2) If arMAT(x1, y1) = arTAB(x, 1) Then For y = 2 To UBound(arTAB, 2) If IsEmpty(arTAB(x, y)) Then arTAB(x, y) = arMAT(x1, 1) Exit For End If Next End If Next Next Next Sheets("Tabelle1").Range("A1").Resize(1801, 1590).value = arTAB End Sub