在单元上循环并在VBA中覆盖它们(如有必要)

我正在尝试检测并处理我的数据中的“重置”。 数据应该一直在增加,但有时传感器喜欢重置到一个更低的值。 我想检测这些并通过将当前值与之前的值相加来纠正它们以获得当前值。

例:

1 2 5 10 11 100 150 2 3 5 

应该:

 1 2 5 10 11 100 150 152 153 155 

这是一个为我工作的Python实现:

 def process(arr): max_before_reset = 0 reset_detected = False old = arr[:] for i, e in enumerate(old): # enumerate contains original array if i == 0: continue if e < old[i-1]: print '\t', e, old[i-1] max_before_reset = arr[i-1] reset_detected = True if(reset_detected): arr[i] = old[i] + max_before_reset print old return arr a = [97, 99, 100, 2, 3, 5, 6, 4, 3]; print process(a) 

这需要在VBA中完成,所以我采取了一些措施:

 Sub ProcessData_test(ByVal RawColumn As String, ByVal ProcessedColumn As String) Dim NumRows As Integer Dim MaxBeforeReset As Integer Dim ResetDetected As Boolean Const ps As String = "test2" Const rds As String = "test1" MaxBeforeReset = 0 ResetDetected = False With Sheets(rds) NumRows = .Range(RawColumn & .Rows.Count).End(xlUp).Row End With 'MsgBox NumRows For i = 1 To NumRows If i = 1 Then Else If Worksheets(rds).Range(RawColumn & i).Value < Worksheets(rds).Range(RawColumn & i).Value Then MaxBeforeReset = Worksheets(ps).Range(ProcessedColumn & (i - 1)).Value ResetDetected = True End If If ResetDetected Then Worksheets(ps).Range(ProcessedColumn & i).Value = Worksheets(rds).Range(RawColumn & i).Value + MaxBeforeReset End If End If Next i End Sub Sub Test() Dim a As String, b As String a = "A" b = "A" Call ProcessData_test(a, b) End Sub 

但由于某种原因,它不会修改test2表格中的单元格。 我似乎无法弄清楚为什么。 有任何想法吗?

简单的错字:

你的路线(注意两边的<是一样的)

 If Worksheets(rds).Range(RawColumn & i).Value < _ Worksheets(rds).Range(RawColumn & i).Value Then 

应该

 If Worksheets(rds).Range(RawColumn & i).Value < _ Worksheets(rds).Range(RawColumn & i - 1).Value Then 

在@chris neilsen的错字,并在这个线程的一些工作后,最后(工作)的脚本在这里:

 Sub ProcessData_test(ByVal RawColumn As String, ByVal ProcessedColumn As String) Dim NumRows As Integer Dim ResetValue As Integer Const ps As String = "test2" Const rds As String = "test1" With Sheets(rds) NumRows = .Range(RawColumn & .Rows.Count).End(xlUp).Row End With 'MsgBox NumRows ResetValue = 0 'First Row Worksheets(ps).Range(ProcessedColumn & 1).Value = Worksheets(rds).Range(RawColumn & 1).Value 'All other rows. For i = 2 To NumRows If Worksheets(rds).Range(RawColumn & i).Value >= Worksheets(rds).Range(RawColumn & i - 1).Value Then Worksheets(ps).Range(ProcessedColumn & i).Value = Worksheets(rds).Range(RawColumn & i).Value + ResetValue Else ResetValue = Worksheets(ps).Range(ProcessedColumn & i - 1).Value Worksheets(ps).Range(ProcessedColumn & i).Value = Worksheets(rds).Range(RawColumn & i).Value + ResetValue End If Next i End Sub