Код VBA, если существуют дублирующиеся значения - PullRequest
0 голосов
/ 11 июля 2019

Я работаю над проблемой Excel, которая, по моему мнению, должна основываться на дубликатах.По сути, если найдены повторяющиеся значения («A: A»), то каким-то образом сгруппируйте их как переменные и заполните соответствующие строки только в том случае, если в них существует хотя бы 1 отрицательное число («B: B»).То же самое относится и к недубликатам, где они должны заполняться только в том случае, если в столбце B существует отрицательное число, но я чувствую, что это легко сделать с помощью формулы

Я пробовал несколько вещей, но основная проблема заключается в определениидубликаты как их собственная переменная.Когда я создаю функцию, которая работает только с выделенными дубликатами, это будет применяться ко всем дубликатам независимо от их индивидуального текста.Это было бы намного проще, если бы суммировать, но это не так.Ниже приведен пример того, что я собираюсь

Problem:

IDs        Trades
US9128     -500
US9128      750
EU9133      900
GD2104     -300
GD2104      150
FG5454      200

Expected:

IDs        Trades
US9128     -500
US9128      750
GD2104     -300
GD2104      150

Открыть для других маршрутов к этой проблеме

1 Ответ

1 голос
/ 11 июля 2019

Предположим, ваши данные в столбце (A: B), Строка начальной формы (1) Попробуйте этот макрос

Option Explicit
Sub test_me()
Dim obj As Object
Dim x, k%
Dim R%, C%
 R = 2: C = 4
Dim lr%: lr = Cells(Rows.Count, 1).End(3).Row
Dim i%, j%
Range("d2").CurrentRegion.ClearContents
Set obj = CreateObject("System.Collections.SortedList")
 For i = 2 To lr
     obj.Add Cells(i, 2).Value, Cells(i, 1).Value
        For j = i + 1 To lr
         If Cells(j, 1) = Cells(i, 1) Then
          obj.Add Cells(j, 2).Value, Cells(j, 1).Value
         End If
        Next j
   x = obj.Count
   If x = 1 Then GoTo NEXT_I
    With Cells(R, C)
     .Value = obj.GetByIndex(0): .Offset(, 1) = obj.Getkey(0)
     .Offset(1) = obj.GetByIndex(x - 1): .Offset(1, 1) = obj.Getkey(x - 1)
    End With
    R = R + 2
NEXT_I:
   obj.Clear
 Next i
 Set obj = Nothing
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...