Суб-копии дублируют диапазон копий слишком много раз - PullRequest
0 голосов
/ 11 июля 2019

У меня есть некоторый код VBA, который должен делать следующее:

  1. Копирование / вставка одного столбца диапазона из другого листа
  2. удалить дубликаты из этого диапазона
  3. вставьте этот диапазон под себя 2 раза, так что есть 3 копии каждого уникального значения, скопированного с исходного листа.

Вот мой код для дублирования диапазона:

Sub paste_multiple(ByVal copy As Range, ByVal times As Long)
    Dim last_row As Long
    For i = 1 To times
        Debug.Print (copy.Address)
        last_row = WorksheetFunction.CountA(ThisWorkbook.Sheets("scratchpad").Range("A:A"))
        copy.copy (ThisWorkbook.Sheets("scratchpad").Range("A" & last_row + 1))
    Next i
End Sub

Вот код, который вызывает эту функцию

Sub generate_SKU_list()
    ThisWorkbook.Sheets("Planning View").Range("A:A").copy (ThisWorkbook.Sheets("scratchpad").Range("A1"))
    Call ThisWorkbook.Sheets("scratchpad").Range("A:A").RemoveDuplicates(Columns:=1, Header:=xlYes)

    Dim lr As Long
    lr = WorksheetFunction.CountA(ThisWorkbook.Sheets("Planning View").Range("A:A")) - 1

    Call paste_multiple(ThisWorkbook.Sheets("scratchpad").Range("A2:A" & lr), 2)

    Call ThisWorkbook.Sheets("scratchpad").Range("A:A").Sort(Key1:=ThisWorkbook.Sheets("scratchpad").Range("A:A"), _
        Order1:=xlAscending, Header:=xlYes)
End Sub

В результате создается 4 копии каждого уникального значения, и я не могу понять, почему.

Любой совет приветствуется, спасибо.

1 Ответ

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

Ваша вставка paste_multiple делает только 2 копии, а вторая копирует весь дубликат диапазона из первой, что дает 4 копии.

Вот альтернатива

Sub paste_multiple(ByVal rCopy As Range, ByVal times As Long)
    Dim Dat As Variant
    Dim i As Long
    Dat = rCopy.Value

    For i = 1 To times
        rCopy.Offset(UBound(Dat, 1) * i,  0).Value = Dat
    Next
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...