Question

我有数据输出到4个通道，每秒一个通道（通道1 =第1秒，通道2 =第2秒等）。因此，时间有4列，关联数据有4列，输出为excel格式。

我创建了一个简单的for循环，将4列数据整理为一个，用于每个参数。共有124个参数，长度为5000-15000个数据点。

我当前的for循环每个循环大约需要16秒，这意味着每次运行大约需要33分钟来整理数据。我不是任何编码或VBA的专家，所以请原谅不良格式等等。只是想知道这里是否有人可能有提高这个for循环速度的建议。最慢的部分似乎是'i'for循环，删除'k'for循环它仍然是16秒或更长时间。

代码如下：

Sub Create_CombinedData()
    '
    ' Create_CombinedData Macro
    '

    Sheets("Sheet2").Select
    graphrange = Application.WorksheetFunction.CountA(ActiveSheet.Columns(1))

    j = 0
    m = 497
    n = 498
    o = 0

    For k = 1 To 124
        For i = 2 To graphrange
            Cells(i + j, m).Value = Cells(2 * i - 2, o + 249).Value
            Cells(i + j, n).Value = Cells(2 * i - 2, o + 250).Value
            Cells(1 + i + j, m).Value = Cells(2 * i - 2, o + 373).Value
            Cells(1 + i + j, n).Value = Cells(2 * i - 2, o + 374).Value
            Cells(2 + i + j, m).Value = Cells(2 * i - 2, o + 1).Value
            Cells(2 + i + j, n).Value = Cells(2 * i - 2, o + 2).Value
            Cells(3 + i + j, m).Value = Cells(2 * i - 2, o + 125).Value
            Cells(3 + i + j, n).Value = Cells(2 * i - 2, o + 126).Value
            j = j + 3
        Next i
        m = m + 2
        n = n + 2
        o = o + 2
        l = 2
        j = 0
    Next k
End Sub

Answer 1

感谢Paul Bica，这是最终的代码。

我不得不玩数组，将其拆分为输入和输出数据。 “arr”加载要组合的数据，“arr 2”是输出组合数据的位置。整个过程分为两部分，数据的上半部分和数据的下半部分 - 否则，我的内存不足。

我无法弄清楚最后一行/最后一列是否有效，所以我粗暴地强迫它使用不同的数字直到它起作用。我确信有一种更合乎逻辑的方式，但它确实为我的应用程序做了它。

希望有所帮助。

Public Sub CreateCombinedData2()
    Dim ws As Worksheet, lr As Long, lc As Long, col1 As Long, col2 As Long
    Dim rId As Long, cr As Long, rr As Long, fr As Long, arr As Variant, arr2 As Variant, k As Long
    Dim half As Long, fCol As Long
    arr = Empty
    arr2 = Emtpy
    Sheets("Sheet3").Cells.ClearContents
    Set ws = ThisWorkbook.Worksheets("Sheet2")  

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Sheet1").ChartObjects.Delete   'this clears previous plots
Application.DisplayAlerts = True
On Error GoTo 0

lr = Application.WorksheetFunction.CountA(ws.Columns(1)) * 2  'last row
lc = Application.WorksheetFunction.CountA(ws.Rows(2)) + 300   'last col
half = lr \ 2

col1 = 497: col2 = 498
arr = ws.Range(ws.Cells(2, 1), ws.Cells(half, lc))          'Top half rows
arr2 = ws.Range(ws.Cells(2, lc), ws.Cells(half, lc * 2))
For k = 1 To 62
Sheets("Sheet3").Select
Cells(1, col1).Value = ws.Cells(1, fCol + 2)
    For cr = 2 To half * 0.25
        rr = cr + rId
        fr = 2 * cr - 2
        arr2(rr + 0, col1) = arr(fr, fCol + 1): arr2(rr + 0, col2) = arr(fr, fCol + 2)
        arr2(rr + 1, col1) = arr(fr, fCol + 125): arr2(rr + 1, col2) = arr(fr, fCol + 126)
        arr2(rr + 2, col1) = arr(fr, fCol + 249): arr2(rr + 2, col2) = arr(fr, fCol + 250)
        arr2(rr + 3, col1) = arr(fr, fCol + 373): arr2(rr + 3, col2) = arr(fr, fCol + 374)
        rId = rId + 3
    Next cr
  col1 = col1 + 2:    col2 = col2 + 2
  fCol = fCol + 2
  rId = 0
Next k
Sheets("Sheet3").Select
Range(Cells(2, 1), Cells(half, lc)) = arr2

col1 = 497
col2 = 498
rId = 0
fCol = 0
rr = 0
fr = 0
arr = Empty
arr2 = Emtpy

arr = ws.Range(ws.Cells(2, 1), ws.Cells(half, lc))     'Bottom half rows
arr2 = ws.Range(ws.Cells(2, lc), ws.Cells(lr, lc * 2))
For k = 1 To 62

    For cr = half * 0.25 To half * 0.5
        rr = cr + rId - half * 0.25 + 1
        fr = 2 * cr - 2
        arr2(rr + 0, col1) = arr(fr, fCol + 1): arr2(rr + 0, col2) = arr(fr, fCol + 2)
        arr2(rr + 1, col1) = arr(fr, fCol + 125): arr2(rr + 1, col2) = arr(fr, fCol + 126)
        arr2(rr + 2, col1) = arr(fr, fCol + 249): arr2(rr + 2, col2) = arr(fr, fCol + 250)
        arr2(rr + 3, col1) = arr(fr, fCol + 373): arr2(rr + 3, col2) = arr(fr, fCol + 374)
        rId = rId + 3
     Next cr
  col1 = col1 + 2:    col2 = col2 + 2
  fCol = fCol + 2
  rId = 0
   Next k


   Sheets("Sheet3").Select
   Range(Cells(half + 1, 1), Cells(lr, lc)) = arr2



Wend

End Sub

Answer 2

下面的代码是初始Sub转换为使用数组（未经测试）。它假设所有数据都在Sheet2上

我不确定最后一列是否正确确定：

目前，它根据第2行中最后一次使用的单元格提取最后一个col（您可能需要调整它）

Option Explicit

Public Sub CreateCombinedData1()
    Dim ws As Worksheet, lr As Long, lc As Long, col1 As Long, col2 As Long
    Dim rId As Long, cr As Long, rr As Long, fr As Long, arr As Variant, k As Long
    Dim half As Long, fCol As Long

    Set ws = ThisWorkbook.Worksheets("Sheet2")                  'or ActiveSheet

    lr = Application.WorksheetFunction.CountA(ws.Columns(1))    'last row
    lc = Application.WorksheetFunction.CountA(ws.Rows(2))       'last col
    half = lr \ 2

    col1 = 497
    col2 = 498
    arr = ws.Range(ws.Cells(2, 1), ws.Cells(half, lc))          'Top half rows
    For k = 1 To 124
      For cr = 2 To half
       rr = cr + rId
       fr = 2 * cr - 2
       arr(rr + 0, col1) = arr(fr, fCol + 249): arr(rr + 0, col2) = arr(fr, fCol + 250)
       arr(rr + 1, col1) = arr(fr, fCol + 373): arr(rr + 1, col2) = arr(fr, fCol + 374)
       arr(rr + 2, col1) = arr(fr, fCol + 1):   arr(rr + 2, col2) = arr(fr, fCol + 2)
       arr(rr + 3, col1) = arr(fr, fCol + 125): arr(rr + 3, col2) = arr(fr, fCol + 126)
       rId = rId + 3
      Next cr
      col1 = col1 + 2
      col2 = col2 + 2
      fCol = fCol + 2
      rId = 0
    Next k
    ws.Range(ws.Cells(2, 1), ws.Cells(half, lc)) = arr

    col1 = 497
    col2 = 498
    rId = 0
    fCol = 0
    rr = 0
    fr = 0
    arr = Empty
    arr = ws.Range(ws.Cells(half + 1, 1), ws.Cells(lr, lc))     'Bottom half rows
    For k = 1 To 124
      For cr = half + 1 To lr
       rr = cr + rId
       fr = 2 * cr - 2
       arr(rr + 0, col1) = arr(fr, fCol + 249): arr(rr + 0, col2) = arr(fr, fCol + 250)
       arr(rr + 1, col1) = arr(fr, fCol + 373): arr(rr + 1, col2) = arr(fr, fCol + 374)
       arr(rr + 2, col1) = arr(fr, fCol + 1):   arr(rr + 2, col2) = arr(fr, fCol + 2)
       arr(rr + 3, col1) = arr(fr, fCol + 125): arr(rr + 3, col2) = arr(fr, fCol + 126)
       rId = rId + 3
      Next cr
      col1 = col1 + 2
      col2 = col2 + 2
      fCol = fCol + 2
      rId = 0
    Next k
    ws.Range(ws.Cells(half + 1, 1), ws.Cells(lr, lc)) = arr
End Sub

Excel VBA低效For循环

2 个答案: