Question

我需要复制数据，但由于需要复制的数据量非常大，并且手工填写，我想通过使用宏来实现。

我无法理解阵列是如何工作的。

这给了我适当数量的副本，但只提供了我需要复制的最后一个单元格。

Sub copyer()

Dim fromH As Integer    'fromheight
Dim fromW As Integer    'fromwidth

Dim toH As Integer      'to height
Dim toW As Integer      'to width

Dim counter As Integer
counter = Worksheets("blad1").Range("D3").Value 'amount of filled-in data lines to copy

Dim Times As Integer    'number of times to run the loop, depending on the filled in data
Times = counter + 1

Dim tostart As Integer  'location where to start placing the data
                        'depending on how much data is already present
Dim toend As Integer    'location up to where to place

tostart = Sheets("blad2").Range("L1").Value + 1 '(+2 if theres a header)
toend = tostart + counter

Dim Copy As Integer

For Copy = 1 To Times
For toH = tostart To toend
    For toW = 1 To 2
        For fromH = 12 To 22 Step 2
            For fromW = 1 To 26 Step 25
                Sheets("blad2").Cells(toH, toW).Value = _
                Sheets("blad1").Cells(fromH, fromW).Value
            Next fromW
        Next fromH
    Next toW
Next toH
Next Copy

'this macro needs to copy the data

'from blad1
'from height 12 to 22 (steps of 2)(10 times)
'from width 1 and 26 (not the cells inbetween)

'to blad2
'to height depending on the data present (dim tostart)'till height needed (steps of 1)
'to width 1 and 2

'blad1, D3 holds the input-datacounter
'blad2, L1 holds the output-datacounter

End Sub

Answer 1

正如泽门斯所提到的，你真的过于复杂了！要复制数组，只需要与数组中的维度一样多的for循环。在这种情况下两个！我使用了一些简单的算法从一张纸转换到另一张纸。它可能不完美，但希望能让你开始！

Dim intRowLoop As Integer, intColLoop As Integer

For intRowLoop = tostart To toend
    For intColLoop = 1 To 2
        Sheets("blad2").Cells(intRowLoop, intColLoop).Value = _
            Sheets("blad1").Cells(12 + ((intRowLoop - tostart) * 2), fromW * 26).Value
    Next intColLoop
Next intRowLoop

Answer 2

最后我去了;

（表单名称不同，因为上面的表格是一个让它运行的测试）

（yust取了重要的一点）

For ToH = tostart To toend Step 2
For ToW = 2 To 8 Step 6
        Sheets("factuur2").Cells(ToH, ToW).Value = _
        Sheets("multiprijs").Cells(FromH, FromW).Value
    FromW = 28
Next ToW
FromH = FromH + 2
ToW = 2
FromW = 5
Next ToH

然而，我对这种方法的问题是＆＃34;宽度＆＃34;这里的变量只能保存2个值;

Width + something 'or
Width to something 'at a regular interval

我想要的是，使这个面向未来的是宽度; 1,3,5,19，任何东西

对于from-to-to width

Ty虽然帮助我做到了这一点：）

用于复制的数组

2 个答案: