Скопируйте 2 диапазона из других листов и вставьте в третий, используя уникальные значения, отсортированные по возрастанию - PullRequest
0 голосов
/ 26 февраля 2020

Я нашел этот код и пытаюсь настроить его для своих целей. Я пытаюсь выбрать столбец в «строке 1» и «строке 4», а затем передать уникальные значения в «Numeri c Plot» в «A2», отсортированном по возрастанию

Option Explicit

 Sub List_Unique_Values()
'Create a list of unique values from the selected column
'Source: https://www.excelcampus.com/vba/remove-duplicates-list-unique-values

Dim rSelection As Range
Dim ws As Worksheet
Dim vArray() As Long
Dim i As Long
Dim iColCount As Long

  'Store the selected range
  Set rSelection = Application.Union(Sheets("Line 1").Range("M4:M204"), Sheets("Line 4").Range("M4:M204"))

  'Add a new worksheet
  Set ws = Sheets("Numeric Plot")

  'Copy/paste selection to the new sheet
  rSelection.Copy

  With ws.Range("A2")
    .PasteSpecial xlPasteValues

  End With

  'Load array with column count
  'For use when multiple columns are selected
  iColCount = rSelection.Columns.Count
  ReDim vArray(1 To iColCount)
  For i = 1 To iColCount
    vArray(i) = i
  Next i

  'Remove duplicates
  ws.UsedRange.RemoveDuplicates Columns:=vArray(i - 1), Header:=xlGuess

  'Remove blank cells (optional)
  On Error Resume Next
    ws.UsedRange.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlShiftUp
  On Error GoTo 0

  'Autofit column
  ws.Columns("A").AutoFit

  `Sort Ascending
  Sheets("Numeric Plot").Range("A2:A204").Sort Key1:=Range("A2:A204"), Order1:=xlAscending

  'Exit CutCopyMode
  Application.CutCopyMode = False

End Sub

Я получаю ошибку 1004 на Set rSelection = Я не уверен, смогу ли я использовать Application.Union или у меня просто что-то не так в синтаксисе.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...