Краткий список в нужный диапазон

[Иванов_ДМ]

Помогите, плиз, разобраться с макросом!
Нужно, чтобы макрос проверил столбец А в листе "Масс1НСРКол" и поместил краткий список значений (без повторов) в лист "СжМасс1КолБр" в столбец А, начиная с 13-й строки. Проблема в том, что он почему-то помещает их в диапазон, начиная с 10-й строки, снося имеющиеся в строках 10-12 данные.
Помогите побороть его!!!

[EducatedFool]

Замените строку Range([A13], Cells(UBound(b, 1) + 1, "A")).Value = b

на строку Range([A13], Cells(UBound(b, 1) + 12, "A")).Value = b
или на строку [A13].Resize(UBound(b, 1)).Value = b

[Иванов_ДМ]

Большое спасибо!
А почему он тогда начинал именно с 10-й?

[EducatedFool]

А почему он тогда начинал именно с 10-й?

Строка Range([A13], Cells(UBound(b, 1) + 1, "A")).Value определяет диапазон для вставки по первой и последней ячейкам этого диапазона.

Одна из ячеек была всегда [A13], а вторая - в столбце A в строке UBound(b, 1) + 1
UBound(b, 1) - это количество обрабатываемых значений (в файле примера равно девяти)

Вот и получалось, что вставка производилась в диапазон с A13 по A10

[Иванов_ДМ]

Теперь все понятно, спасибо!

[Иванов_ДМ]

Еще один вопрос: В макросе используются данные из листа Масс1НСРКол столбца A.
А если данные нужно взять из столбца скажем C, то что нужно поменять в макросе?
СК

[EducatedFool]

Sub МассивБрендыКол()
    НомерСтолбца = 6: НомерПервойСтроки = 3    ' откуда берём данные
    НомерСтолбцаДляВставки = 7: НомерПервойСтрокиДляВставки = 2    ' куда вставляем данные

    Dim i As Long, j As Long, x As New Collection, a, b()
    Application.ScreenUpdating = False
    Sheets("СжМасс1КолБр").Activate
    Range(Cells(НомерПервойСтрокиДляВставки, НомерСтолбцаДляВставки), Cells(Rows.Count, НомерСтолбцаДляВставки)).ClearContents
    With Sheets("Масс1НСРКол")
        a = .Range(.Cells(НомерПервойСтроки, НомерСтолбца), .Cells(Rows.Count, НомерСтолбца).End(xlUp)).Value
    End With
    ReDim b(1 To UBound(a, 1), 1 To 1): j = 1
    For i = 1 To UBound(a, 1)
        If a(i, 1) <> "" Then
            On Error Resume Next: x.Add a(i, 1), CStr(a(i, 1))
            If Err = 0 Then
                b(j, 1) = a(i, 1): j = j + 1
            Else: On Error GoTo 0
            End If
        End If
    Next
    Cells(НомерПервойСтрокиДляВставки, НомерСтолбцаДляВставки).Resize(UBound(b, 1)).Value = b
End Sub

[Иванов_ДМ]

Спасибо, все работает!!!

[Иванов_ДМ]

Educated Fool, а подскажите пожалуйста, как в этом коде сделать так, чтобы он помещал данные в диапазон "B2" и далее по столбцам направо (а не по строкам вниз), ну то есть транспонировал их в строку?
Заранее спасибо!

[EducatedFool]

Например, так:

Sub Заполнение()
    Dim cell As Range, ra As Range: Application.ScreenUpdating = False
    Dim coll As New Collection: On Error Resume Next
    Set ra = Range([A3], Range("A" & Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        Err.Clear: coll.Add cell, cell & "z"
        If Err.Number <> 457 Then Cells(2, coll.Count + 1) = cell
    Next cell
End Sub

Sub Очистка()
    [b2:iv2].ClearContents
End Sub