Нужна помощь, чтобы настроить числа в столбце

Question

У меня есть числа в столбце, и я пытаюсь проверить, есть ли выравнивающие значения + и -, используя как прямое соответствие (т. Е. +10 - -10), так и косвенное (т. Е. * 1005)* равняется двум -5 значениям)

Всегда следует проверять наличие прямых совпадений, прежде чем переходить к косвенному совпадению.

---

В приведенном вышеНапример, 5 и -5 совпадают, и затем никакие другие совпадения 1-1 не найдены, поэтому мы пытаемся снова использовать косвенные совпадения, и на этот раз 10 сопоставляется с -6 и -4. 3 совпадает ни с чем и поэтому не имеет значение true.

---

ColA  ColB
20    True
10    True
-20   True
-5    True
2
-5    True

Здесь 20 соответствует -20, а затем, после того, как дальнейшие совпадения 1-1 не найдены, мы используем косвенныйсоответствие 10 соответствие -5 и -5. Единственное оставшееся число - 2, и ему не с чем сопоставлять, и поэтому оно не установлено в true.

---

Можно ли заставить код VBA работать аналогично для тысяч записей как для прямой, так и для прямой записи? косвенный.

Приведенный ниже код работает для точных совпадений значений + и -, но не косвенных совпадений:

Sub test()
Dim i As Integer

lastrow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lastrow
'49407
    If Sheet1.Range("A" & i).Interior.Color = 16777215 Then
        matchedvalue = Sheet1.Range("A" & i).Value

        If Left(matchedvalue, 1) = "-" Then
            matchedvalue = Replace(matchedvalue, "-", "")
        Else
            matchedvalue = "-" & matchedvalue
        End If

        For K = i + 1 To lastrow
            If Sheet1.Range("A" & K).Interior.Color = 16777215 Then
                If Sheet1.Range("A" & K).Value = CLng(matchedvalue) Then
                Sheet1.Range("A" & i).Interior.Color = 49407
                Sheet1.Range("B" & i).Value = "True"
                Sheet1.Range("A" & K).Interior.Color = 49407
                Sheet1.Range("B" & K).Value = "True"
                Exit For
                End If
            End If
        Next K

    End If

Next i

End Sub

Answer 1

Вот решение, которое найдет, где 1 ячейка совпадает с 1 или 2 другими ячейками. Если вам нужно больше 2, вы можете вложить еще 1 тест, но помимо этого я бы хотел взглянуть на форму рекурсивного тестирования - или на решение SQL, как я упоминал в своем комментарии.

You 'Заметьте, я не читаю каждую клетку в отдельности. Это общеизвестно медленно, особенно после 1000-го ряда. Вместо этого я читаю значения в массив и проверяю там. Закончив, я записываю результат обратно на лист. Я проверил это на 5000 целых чисел в диапазоне от -500 до +500, и время, затрачиваемое на это, сократилось примерно на 95%.

Я прокомментировал код, чтобы вы могли следить за тем, что я сделал. Вместо того, чтобы окрашивать ячейки, я использовал столбец B, чтобы решить, использовалась ли уже ячейка. Если вам действительно нужны цвета, возможно, добавьте условное форматирование после «вставки».

Sub test()

Dim i As Long
Dim vls As Variant

'find last populated cell in column A
lastrow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row

'copy columns A:B down to lastrow into array called VLS
vls = Sheet1.Range("A1:B" & lastrow).Value

'start reading from top of array (ignoring header)
For i = 2 To lastrow
    'if value is unused so far
    If vls(i, 2) <> "True" Then
        'copy value to test1
        test1 = vls(i, 1)
        'start 2nd loop, starting below value found in test1
        For k = i + 1 To lastrow
            'if this value is unused so far
            If vls(k, 2) <> "True" Then
                'copy this (2nd) value to test2
                test2 = vls(k, 1)
                'do test1 and test2 add up to zero?
                If test2 + test1 = 0 Then
                    'if yes, mark them as used
                    vls(i, 2) = "True"
                    vls(k, 2) = "True"
                    'and then quit this loop
                    Exit For
                'otherwise
                Else
                    'start a 3rd loop
                    For m = k + 1 To lastrow
                        'if this 3rd value is unused then..
                        If vls(m, 2) <> "True" Then
                            'do test1 and test2 and test3 add up to zero?
                            If vls(m, 1) + test1 + test2 = 0 Then
                                'if yes, mark them as used
                                vls(i, 2) = "True"
                                vls(k, 2) = "True"
                                vls(m, 2) = "True"
                                'set k to end to cause this and outer loop to quit
                                k = lastrow
                                'and then quit the loop
                                Exit For
                            End If
                        End If
                    Next m
                End If
            End If
        Next k
    End If
Next i

'paste the values within VLS back to the sheet.
Range("A1:B" & lastrow).Value = vls

End Sub

В качестве последнего примечания, если ваши ячейки не являются целыми числами, рассмотрите возможность добавления округления к If test2 + test1 = 0 Then и т. Д. разрешить найденные десятичные ошибки.