Question

我正在一个项目中扫描一列中的日期列表，然后扫描另一列中的值，然后将值附加到第三列中的字符串。我遇到的麻烦是将相同的值附加到指定日期以上的每个单元格。数据如下：

我需要发生的事情是，对于last_month_row以上尚未附加值的每个单元格，将T1，T2等值附加到代码中。它应该看起来像这样：

到目前为止，我的代码是这样：

Sub Test_Logic()
Dim lastrow As Long, lastcolumn As Long, lastrow_reps As Long
Dim tmp As String, arr() As String, msg As String
Dim cell As Range
Dim i As Integer, j As Integer
Dim last_month As Long
Dim last_month_row As String, first_month_row As String
Dim ws As Worksheet, ws2 As Worksheet
Dim wb As Workbook
Dim reps As Variant, quota As Variant, repslist As Variant, ACV As Variant

Set wb = ActiveWorkbook
Set ws2 = wb.Sheets("Rep_Commission")
lastrow_reps = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Set repslist = ws2.Range("A3:A" & (lastrow_reps))
Set ACV = ws2.Range("B3:B" & (lastrow_reps))

With wb
For Each reps In repslist
Set ws = Worksheets(reps.Text)
Set ACV = ws2.Range("A1:A99").Find(reps, LookIn:=xlValues).Offset(, 1)

lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row

    For Each cell In ws.Range("I2:I" & lastrow)
        If (cell <> "") And (InStr(tmp, cell) = 0) Then
            tmp = tmp & cell & "|"
        End If
    Next cell

If Len(tmp) > 0 Then tmp = Left(tmp, Len(tmp) - 1)
    arr = Split(tmp, "|")
        For i = LBound(arr) To UBound(arr)
            msg = msg & arr(i) & vbNewLine
        Next i

For i = LBound(arr) To UBound(arr)
    'the error occurs here
    last_month = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 6).Value
    last_month_row = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 7).Row
    first_month_row = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlNext).Offset(, 7).Address
        If last_month < (ACV / 2) Then
            ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 7).Value = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 5).Value & "T1"
                For j = 2 To last_month_row - 1
                    If ws.Range("I" & j).Value = arr(i) Then
                        ws.Range("P" & j).Value = ws.Range("P" & j).Value & "T1"
                    End If
                Next j
        ElseIf last_month > (ACV / 2) And last_month < ACV Then
            ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 7).Value = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 5).Value & "T2"
                For j = 2 To last_month_row - 1
                    If ws.Range("I" & j).Value = arr(i) Then
                        ws.Range("P" & j).Value = ws.Range("P" & j).Value & "T2"
                    End If
                Next j
        ElseIf last_month > ACV And last_month < (ACV * 1.5) Then
            ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 7).Value = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 5).Value & "T3"
                For j = 2 To last_month_row - 1
                    If ws.Range("I" & j).Value = arr(i) Then
                        ws.Range("P" & j).Value = ws.Range("P" & j).Value & "T3"
                    End If
                Next j
        ElseIf last_month > (ACV * 1.5) Then
            ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 7).Value = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 5).Value & "T4"
                For j = 2 To last_month_row - 1
                    If ws.Range("I" & j).Value = arr(i) Then
                        ws.Range("P" & j).Value = ws.Range("P" & j).Value & "T4"
                    End If
                Next j
        Else 'Do nothing yet, or maybe some error handling??
        End If
Next i
Next reps
End With

End Sub

我不知道如何将“ T”值添加到正确的单元格-我尝试遍历first_month_row和last_month_row创建的范围，但最终只是附加了T值的倍数。任何建议将不胜感激。

编辑：所以我能够成功填充单元格，但是当我尝试遍历工作表时，出现“对象变量或未设置块变量”错误。它发生在此行：

last_month = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 6).Value

但是last_month是单个值，而不是对象，因此我不知道为什么会发生这种情况。

Answer 1

您的子程序完全按照您的编程进行。它找到arr(i)的最后一次出现，并在P列中仅为最后一行设置值。您宁愿使用这种方法循环使用具有相同日期的范围：

Dim last_month_row as long, first_month_row as long, k as long

For i = LBound(arr) To UBound(arr)
    last_month_row = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlPrevious).Offset(, 7).row
    first_month_row = ws.Range("I2:I" & lastrow).Find(What:=arr(i), searchdirection:=xlNext).Offset(, 7).row

    For k = first_month_row to last_month_row 
     If last_month < (ACV / 2) Then
        ws.cells(k, "P").Value = ws.cells(k, "N").Value & "T1"
        ...

此外，我建议使用Long而不是Integer。 VBA可以使用多头，您不能用整数保存任何内容，但是您可能会遇到超过65K的溢出。

Answer 2

我认为您需要为“ I”列添加另一个包含“仅”“唯一”值的数组/集合，然后使用此唯一值在您的选择中进行迭代/搜索，如下所示的伪代码：

select * from ( select * from (select * from..........

对我来说，创建唯一的“列表”的最简单方法是使用“集合”：

For Each Unq in UniqueDate
     For i = LBound(arr) To UBound(arr)
           // Here, use "Unq" instead of "arr(i)" to search/find your target value
     next i
next Unq

根据其他单元格中的值将字符串追加到单元格

2 个答案: