Question

我希望excel遍历列的每个单元格，对其执行操作，然后将结果复制到另一列。这是我最初的代码：

For i = 2 To dataRows
    '    Cells(i, aStampCol) = Cells(i, stampCol) - stim1TimeStamp 
    'Next i

这段代码确实有效，但运行速度非常慢，我查看了另一个post，他们说最好将列复制到一个数组中，对其进行操作，然后将其复制回一列。 / p>

所以我写了下面的代码：

cellsAStamp = Range(Cells(2, stampCol), Cells(datarows, stampCol)) 
For i = 0 To datarows - 2
    cellsAStamp(i) = cellsAStamp(i) - stim1TimeStamp
Next i

Range(Cells(2, aStampCol), Cells(endRow, aStampCol)) = cellsAStamp

问题是，只要启动for循环，我就会得到一个＆＃34;下标超出范围＆＃34;错误。我得到的印象是cellsAsStamp没有正确存储数据，但我不知道如何解决这个问题，或者就此而言，问题是什么！

我已粘贴下面的完整代码，以便您了解我如何初始化变量：

Sub WM()
Dim col As Integer
Dim spanCol As Integer
Dim msgCol As Integer
Dim stampCol As Integer   'The column containing the timestamp
Dim aStampCol As Integer 'The column containing the adjusted timestamp
Dim row As Long
Dim startRow As Long
Dim stimRow As Long 'the row on the Sample_Message column that says "stim1"
Dim endRow As Long  'the row on the Sample_Message column that says "participant_trial_end"
Dim triNum() As String 'a string array that will hold "Trial: x" after it has been split
Dim stim1TimeStamp As Long
Dim cellsAStamp() As Variant 'will contain the names of all the NoBlink sheets to allow for

'Identifies Timestamp column, adds ADJUSTED_TIMESTAMP column
For stampCol = 1 To 10
    If Cells(1, stampCol) = "TIMESTAMP" Then
            aStampCol = stampCol
            colLetter = ConvertToLetter(stampCol)
            Columns(colLetter & ":" & colLetter).Select
            Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            stampCol = stampCol + 1
            Cells(1, aStampCol) = "ADJUSTED_TIMESTAMP"
        GoTo out
    End If
Next stampCol

out:

'Identifies Trial Label column
For col = 1 To 10
    If Cells(1, col) = "TRIAL_LABEL" Then
        GoTo out1
    End If
Next col

out1:

'Identifies Span column
For spanCol = 1 To 10
    If Cells(1, spanCol) = "span" Then
        GoTo out2
    End If
Next spanCol

out2:

'Identifies Message column
For msgCol = 1 To 10
    If Cells(1, msgCol) = "SAMPLE_MESSAGE" Then
        GoTo out3
    End If
Next msgCol

out3:

'Goes through Trial_Label column and deletes trials 1 and 2
row = 2
While Cells(row, col) Like "Trial: [12]"
    row = row + 1
 Wend
 row = row - 1

    If row = 1 Then 'in case the trials weren't there, it wont start at the header
        row = 2
        GoTo skipDelete
    End If

 Rows("2:" & CStr(row)).Delete

skipDelete:

'Goes through Trial_Label column and stops once the trial changes
row = 2
GoTo stillMoreLeft
stillMoreLeft:
 startRow = row
 currTrial = Cells(row, col) 'did not initialize currSpan and currTrial as strings
 currSpan = Cells(row, spanCol)

    While currTrial = Cells(row, col)
        'highlights any row that has a message
        If Cells(row, msgCol) <> "." Then
            Rows(CStr(row) & ":" & CStr(row)).Interior.Color = vbYellow
        End If

        'Identifies the row that contains "stim1" in Sample_Message
        If Cells(row, msgCol) = "stim1" Then
            stimRow = row
        End If

        'Identifies the row that contains "participant_trial_end" in Sample_Message
        If Cells(row, msgCol) = "participant_trial_end" Then
            endRow = row
        End If

        row = row + 1
    Wend
    row = row - 1
'Copies all of the rows containted in a trial
Rows(CStr(stimRow) & ":" & CStr(endRow)).Select
Selection.Copy

'Creates new sheet that will be named appropriately
Worksheets.Add
triNum = Split(currTrial)
currSheetName = "Trial" & triNum(1) & "Span" & currSpan
ActiveSheet.Name = currSheetName

'Pastes all the rows contained in at trial
Rows("2:2").Select
ActiveSheet.Paste

'Gets timestamp for stim1
stim1TimeStamp = Cells(2, stampCol)

'Puts the whole timestamp column in an array/ Does the appropriate calculations to each value
datarows = endRow - stimRow + 2
cellsAStamp = Range(Cells(2, stampCol), Cells(datarows, stampCol)) 'looks like a legit way to use range
For i = 0 To datarows - 2
    cellsAStamp(i) = cellsAStamp(i) - stim1TimeStamp
Next i

Range(Cells(2, aStampCol), Cells(endRow, aStampCol)) = cellsAStamp

'Fills the Adjusted_TimeStamp column
'dataRows = endRow - stimRow + 2
'For i = 2 To dataRows
'    Cells(i, aStampCol) = Cells(i, stampCol) - stim1TimeStamp 'This equation says: the Adjusted_Time_Stamp=TimeStamp-TimeStamp of Stim1
'Next i

'Copies header row and pastes it to first row of most recent trial sheet
Sheets(ActiveWorkbook.Name).Select
Rows("1:1").Select
Selection.Copy
Sheets(currSheetName).Select
Rows("1:1").Select
ActiveSheet.Paste

row = row + 1 'we increment the row so that on the next line, when they check for whether the cell is empty or not, we aren't looking at the last cell of our current trial, but the first cell of our following trial
Sheets(ActiveWorkbook.Name).Select

'Looks to see if there is still a trial left, if so, it goes through all of it
If Cells(row, col) <> "" Then
    GoTo stillMoreLeft
Else
    bob = 1 + 1
End If

End Sub

Function ConvertToLetter(iCol As Integer) As String
Dim iAlpha As Integer
Dim iRemainder As Integer
iAlpha = Int(iCol / 27)
iRemainder = iCol - (iAlpha * 26)
If iAlpha > 0 Then
  ConvertToLetter = Chr(iAlpha + 64)
End If
If iRemainder > 0 Then
  ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
End If
End Function

Answer 1

当您将一个范围读入数组时，它将是一个2D数组（从1开始） - 第一维是行，第二维是列 - 即使只有一列。所以试试：

cellsAStamp(i,1) = cellsAStamp(i,1) - stim1TimeStamp

为什么我的下标超出了vba的范围？

1 个答案: