Question

我是vba的新手，不确定如何解决下文所述的最佳方法。

我有一个Excel工作表，其中包含三列-ID，阶段和收入。 ID字符串可以重复2次或更多次，因此未知重复ID的数量。我正在寻找两个标准，一个可以解决，但第二个没有。

第一个条件是参考“阶段”列。如果Stage = = 5，那么它将自动获取写在最后一列中的Accept值，如果未写入5 Reject。

第二个条件要求我找到每个重复ID，并为该特定重复ID找到最高的收入值。如果它的最高值标记为“接受”，则由于我设置第一个条件的方式，较低的值将在它们旁边已经被拒绝。

        Sub FindandAssignValue()


    'This will check to see if Stage is a 5 if yes it will Accept if not it 
    'will say Remove -  this works properly


     For currentRow = 2 To LastRow

     'Will tell me the current value in the leadstage column
     currentValue = Range("I" & currentRow).Value

     If currentValue = "5" Then
        Range("N" & currentRow).Value = "Accept"
     Else
        Range("N" & currentRow).Value = "Remove"
     End If

     Next currentRow

     currentValue = Range("A" & currentRow).Value


     Dim MyArray(1 To lr, 1 To lc) As Variant
    'fill up the rows

           For r = 1 To lr

              For c = 1 To lc     'fill the columns up
              MyArray(r, c) = Cells(r + 1, c).Value


            Next c
          Next r
    End Sub

excel sheet

Answer 1

如果添加必要的引用（Open VB Editor > Tools > References > Scroll down until you find "Microsoft Scripting Runtime" > Tick it > Click OK），我认为这段代码应该可以工作。

您可能需要将someSheet的名称更改为您的工作表名称。
我假设您的源数据（包括标题）始于单元格A1，结束于列C的某一行。您可以根据需要进行更改。
结果将从单元格H1开始写入表中。您可以根据需要进行更改。

Private Sub AcceptOrRejectSomeValues()

    Dim someSheet As Worksheet
    Set someSheet = ThisWorkbook.Worksheets("Sheet10") ' Change to whatever yours is called.

    Dim lastRow As Long
    lastRow = someSheet.Cells(someSheet.Rows.Count, "A").End(xlUp).Row
    Debug.Assert lastRow > 1

    Dim dataIncludingHeaders As Range
    Set dataIncludingHeaders = someSheet.Range("A1", "C" & lastRow)

    Dim inputArray() As Variant
    inputArray = dataIncludingHeaders.Resize(, dataIncludingHeaders.Columns.Count + 1).Value

    Const ID_COLUMN_INDEX As Long = 1
    Const STAGE_COLUMN_INDEX As Long = 2
    Const REVENUE_COLUMN_INDEX As Long = 3
    Const RESULT_COLUMN_INDEX As Long = 4

    Dim booleanArray() As Boolean
    ReDim booleanArray(1 To UBound(inputArray))

    Dim idsAndRowIndexes As Scripting.Dictionary
    Set idsAndRowIndexes = New Scripting.Dictionary

    Dim rowIndex As Long
    For rowIndex = (LBound(inputArray, 1) + 1) To UBound(inputArray, 1)
        booleanArray(rowIndex) = (inputArray(rowIndex, STAGE_COLUMN_INDEX) = "5")

        Dim currentKey As String
        currentKey = CStr(inputArray(rowIndex, ID_COLUMN_INDEX))

        If idsAndRowIndexes.Exists(currentKey) Then
            If inputArray(rowIndex, REVENUE_COLUMN_INDEX) > inputArray(idsAndRowIndexes(currentKey), REVENUE_COLUMN_INDEX) Then
                idsAndRowIndexes(currentKey) = rowIndex
            End If
        Else
            idsAndRowIndexes(currentKey) = rowIndex
        End If
    Next rowIndex

    Dim id As Variant
    For Each id In idsAndRowIndexes.Keys
        booleanArray(idsAndRowIndexes(id)) = True
    Next id

    For rowIndex = LBound(inputArray, 1) To UBound(inputArray, 1)
        If booleanArray(rowIndex) Then
            inputArray(rowIndex, RESULT_COLUMN_INDEX) = "Accept"
        Else
            inputArray(rowIndex, RESULT_COLUMN_INDEX) = "Reject"
        End If
    Next rowIndex

    someSheet.Range("H1").Resize(UBound(inputArray, 1), UBound(inputArray, 2)).Value = inputArray

End Sub

如何根据重复项在一行中查找重复值，然后在另一列中查找最大值

1 个答案: