Question

我的问题如下：

表A在第一列中的类型X的数字之后排序; 在每行中，几个类型的Y可以与一个数字相关联 X型; 类型Y的数字可以与不同数量的类型X
我的目标是对表格进行排序，以便最终得到一个新表格显示与任何一个Y型相关联的X型的所有数字; （当然可能有几个X型链接到Y型之一）
我只有一些C＃和Java的基本经验，无论如何都在VBA中，但是如果不是因为某些错误，我会编写一些可能会起作用的代码关于＆＃34;不匹配类型的消息＆＃34;变量和不正确的索引细胞。
基本上我想做的就是整理表格并查看是否存在对于数字类型X，类型Y的任何条目，如果是，则将该X写入a 新表成对应的Y行：

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

请问有人给我一些建议吗？这个想法本身很简单。

也许在将重新排列的条目写回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如果包含多个单元格，则会返回二维数组，并且嵌套循环假设它有2个维度。但是，当您将多维数组传递给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中存储对象引用。但表达式的右侧被视为Boolean。这有两个问题。首先，VBA无法测试两个阵列的公平性（它会导致类型不匹配） - 您需要遍历这些元素。其次，即使您可以，表达式也会返回Boolean，但不能将Set分配给具有myRow1的对象。

我没有比这更进一步，但还有其他一些事情需要提及：

您无需初始化myRow2，myCol2或For myRow1 = {#} To ...。 #行会将它们初始化为With的所有内容。
在第With Sheets("Tabelle1")行创建Sheets("Tabelle1")块时，您可以省略块内所有位置的.Cells(myRow2, myCol2) = myArr(myRow1, 1)。即Sheets("Tabelle1").Cells(myRow2, myCol2) = myArr(myRow1, 1)而不是public struct CInput { public IntPtr array; } public VideoView() { InitializeComponent(); Loaded += OnLoaded; float[] test = new float[4]; CInput input = new CInput(); input.array = Marshal.AllocHGlobal(Marshal.SizeOf<float>() * test.Length); Marshal.Copy(test, 0, input.array, test.Length); D3DPanel.CreateMesh(out input, test.Length); Marshal.FreeHGlobal(input.array); }

Answer 2

我认为包含用于验证代码的测试会很有趣。

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

测试

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

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

2 个答案:

测试

万客隆