Как я могу скопировать и вставить только уникальные значения в VBA?

Question

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

введите изображение [] 1 здесь

Как я упоминал выше, таблицы являются динамическими c. если число увеличивается, сумма добавляет новую строку, а сумма (абс) всегда содержит две пустые ячейки между ними. Любые предложения помощь осуществляется?

Answer 1

Вы можете использовать RemoveDuplicates() метод Range объекта:

Sub Test()
    With Worksheets("MySheetName") ' change "MySheetName" to your actual sheet name
        With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
            With .Range(.Find(What:="Amount(ABS)", LookIn:=xlValues, LookAt:=xlWhole).Offset(1), .Cells(.Count))
                .Offset(, 1).Value = .Value
                .Offset(1).RemoveDuplicates Columns:=1, Header:=xlNo
            End With
        End With
    End With
End Sub

Answer 2

Если у вас есть доступ к функции UNIQUE в Excel:

1. Определите свой диапазон сумм ABS, используя определенные переменные Found и lr
2. Выведите Функция UNIQUE вправо для дублирования вашего диапазона
3. Очистка диапазона формулы / разлива с помощью переноса значения (Range.Value = Range.Value)

---

Sub Social_Distance()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2") '<-- Update Sheet Name
Dim Found As Range, lr As Long

lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set Found = ws.Range("A1:A" & lr).Find(What:="Amount(ABS)", LookIn:=xlValues, LookAt:=xlWhole)

If Not Found Is Nothing Then

    Found.Offset(, 1) = "Unique Values"
    Found.Offset(1, 1) = "=UNIQUE(" & ws.Range(ws.Cells(Found.Offset(1).Row, 1), ws.Cells(lr, 1)).Address(False, False) & ")"

    ws.Range(ws.Cells(Found.Offset(1).Row, 2), ws.Cells(lr, 2)).Value = ws.Range(ws.Cells(Found.Offset(1).Row, 2), ws.Cells(lr, 2)).Value

End If

End Sub