Ошибка «Присвоение константе» при попытке получить уникальные значения из таблицы - PullRequest
Новая
       16

Ошибка «Присвоение константе» при попытке получить уникальные значения из таблицы

0 голосов
/ 03 сентября 2018

Я пытаюсь получить уникальные значения из таблицы tblDetails столбец Names и вставить в таблицу tblNames Имена столбцов.

Однако в последней строке кода ниже:

tbl2.Resize(d.Count) = Application.Transpose(d.keys)

... Я получаю эту ошибку:

Ошибка компиляции:
Присвоение константе не разрешено

Я не могу понять, что является причиной этой ошибки.

Любая помощь будет оценена. 

Sub Get_Unique_Values()
    Dim dict As Object, arr, j, arrCustomers
    Set dict = CreateObject("Scripting.Dictionary")
    Dim tbl1 As ListObject, tbl2 As ListObject
    Dim d As Object, i As Long, c As Variant

    Set tbl1 = Worksheets("Sheet1").ListObjects("tblTest")
    Set tbl2 = Worksheets("Sheet1").ListObjects("tblTest2")

    If Not tbl2.DataBodyRange Is Nothing Then 'Clean tblTest2
        tbl2.AutoFilter.ShowAllData
        tbl2.DataBodyRange.Delete
    End If

    Set d = CreateObject("Scripting.Dictionary")
    c = tbl1.ListColumns(1).DataBodyRange 'Loop through Table
    For i = 1 To UBound(c, 1)
        d(c(i, 1)) = 1
    Next i

    tbl2.Resize(d.Count) = Application.Transpose(d.keys) 'Export result to table
End Sub

1 Ответ

0 голосов
/ 07 сентября 2018

@ JohnyL @ashleedawg @Harassed Папа, после многих попыток мне удается получить то, что я хочу, спасибо всем за ваш ответ и рекомендации. 

Sub Get_Unique_Values()

Dim i As Long
Dim tbl1 As ListObject, tbl2 As ListObject
Dim d As Object
Dim c As Variant
Dim CountD As Long, LastRow As Long
Dim rng As Range

Set tbl1 = Worksheets("Sheet1").ListObjects("tblNames")
Set tbl2 = Worksheets("Sheet1").ListObjects("tblTest2")

If Not tbl2.DataBodyRange Is Nothing Then 'Clean tblTest2
    tbl2.AutoFilter.ShowAllData
    tbl2.DataBodyRange.Delete
End If

Set d = CreateObject("Scripting.Dictionary")
c = tbl1.ListColumns(1).DataBodyRange 'Loop through Table
For i = 1 To UBound(c, 1)
    d(c(i, 1)) = 1
Next i

CountD = d.Count
LastRow = Sheet1.ListObjects("tblTest2").Range.Rows.Count

Set rng = Range("tblTest2[#All]").Resize(tbl2.Range.Rows.Count + CountD - 1, tbl2.Range.Columns.Count)

tbl2.Resize rng

Range("tblTest2[Column1]") = Application.Transpose(d.keys)  'Export result to table

End Sub
...