а записать макрорекодером? и вставить вначале кода i=val(inputbox("введите номер столбца"))  
потом  Columns(i).Select  
и дальше то, что макрорекодером записано  
а?

sub тест  
i = Val(InputBox("vvedi"))  
 
   Columns(i).Select  
   Selection.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _  
       "B1"), Unique:=True  
 
end sub  
 
глобально не тестировал, но вроде работает, создает список уникальных значений во втором столбце с ячейки В1

Уважаемый yozhik, к сожалению, у меня не работает этот код. То есть он вставляет ВСЕ записи, с повторениями. Но спасибо за подсказку. Ща буду разбираться.  
Кстати, а можно как-то сделать так, чтобы выбирать не номер столбца, а заголовок соответствующего столбца?  
 
То есть каждый столбец у меня имеет заголовок. Можно как-то сделать так, чтобы мне предлагался список заголовков и я бы мог выбирать нужный столбец с помощью заголовка?  
Может listbox или какая-то другая функция?  
 
Спасибо

выбор заголовка можно организовать в ячейке с помощью выпадающего списка через data-validation-выбрать list-задать диапазон. в коде прописать переменную, которой присваивать выбираемое значение, далее прописать поиск значения переменной в строке заголовка и другой переменной присвоить номер столбца. а дальше тож самое. Прошу прощения, сам с ходу не напишу, но все можно частями найти на сайте и собрать в кучу. код небольшой выйдет. так же можно сделать выбор заголовка через Dialog - навести мышь на заголовок листа, правая кнопка - insert-MS Excel 5.0 Dialog, а потом в коде вызвать это окно. проще, чем свою форму создавать.

Вот, выберите, что надо:  
 
Function NoDups(Rng As Range, Optional Mask = "*")  
 Dim Arr(), i&, s$, x  
 ' Считать данные в массив, для удобства ограничиться последней строкой данных листа  
 Arr = Intersect(Rng.Parent.UsedRange, Rng).Value  
 ' Создать список  
 On Error Resume Next  
 With New Collection  
   For Each x In Arr()  
     s = Trim(x)  
     If Len(s) > 0 Then  
       If IsEmpty(.Item(s)) Then  
         If s Like Mask Then  
           ' Оригинальный достаточно быстрый вариант добавления значения в коллекцию с сортировкой (from PGC01)  
           For i = 1 To .Count  
             If s < .Item(i) Then Exit For  
           Next  
           If i > .Count Then .Add s, s Else .Add s, s, Before:=i  
         End If  
       End If  
     End If  
   Next  
   ' Скопировать из коллекции в массив  
   ReDim Arr(1 To .Count)  
   For i = 1 To .Count  
     Arr(i) = .Item(i)  
   Next  
 End With  
 ' Вернуть массив  
 NoDups = Arr()  
End Function

{quote}{login=Hugo}{date=11.04.2010 09:44}{thema=}{post}Хотя можно брать целиком.  
Использовать так:  
 
Sub test()  
temp = NoDups(Columns(8))  
For i = 1 To UBound(temp)  
   Cells(i, 1) = temp(i)  
Next  
End Sub  
{/post}{/quote}  
Спасибо.  
мне просто код короткий понравился  
Columns("A:A").Select  
Selection.AdvancedFilter , Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True  
может добавить туда Order:=xlAscending для сортировки

спасибо. пригодились оба метода

эта функция ведь может выбирать диапазон не только одномерный,  
вот и заинтересовало как можно это сделать прямо в массив  
nodups хорошо, но надо в многомерный массив данные занести  
ну типа arr=[a1:c5].value

Но ведь можно параллельно с занесением в коллекцию или словарь (кстати, тогда можно уникальные не по одному полю брать, а например по A&C&E) сразу же набивать итоговый массив из нужных полей.  
Вот только сортировку продумать... можно позже отсортировать.

{quote}{login=Hugo}{date=27.09.2010 10:07}{thema=}{post}Но ведь можно параллельно с занесением в коллекцию или словарь (кстати, тогда можно уникальные не по одному полю брать, а например по A&C&E) сразу же набивать итоговый массив из нужных полей.  
Вот только сортировку продумать... можно позже отсортировать.{/post}{/quote}  
Во общем пока ничего путного не нашел, мне бы без сортировки получить диапазон уникальных значений в многомерный массив т.е. то что возвращает AdvancedFilter из    
примерно такого диапазона range("A1:C10").AdvancedFilter , Action:=xlFilterCopy, CopyToRange:=tocopy, Unique:=True

{quote}{login=n1}{date=27.09.2010 11:56}{thema=}{post}вот что то подобное только ьез промежуточной выгрузки на лист{/post}{/quote}  
поправьте  
arr = Range("H1:K" & Cells(Rows.Count, 8).End(xlUp).Row).Value

Вот переделал другой код. Результат идентичен.  
 
Sub SvodByHugo()  
   Dim lr As Long, i As Long  
   Dim a, b, temp As String  
   Dim oDict1 As Object  
   Dim cnt As Long  
   lr = Cells(Rows.Count, 1).End(xlUp).Row  
   a = Range(Cells(1, 1), Cells(lr, 4)).Value  
   ReDim b(1 To UBound(a), 1 To 4)  
     
   Set oDict1 = CreateObject("Scripting.Dictionary")  
   For i = 1 To UBound(a)  
       With oDict1  
           temp = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) & "|" & a(i, 4)  
           If Not .Exists(temp) Then  
           cnt = cnt + 1  
               .Add temp, cnt  
               b(cnt, 1) = a(i, 1)  
               b(cnt, 2) = a(i, 2)  
               b(cnt, 3) = a(i, 3)  
               b(cnt, 4) = a(i, 4)  
           End If  
       End With  
   Next  
 
   With ThisWorkbook.Worksheets(1)  
    .Range("H1:K" & cnt) = b  
   End With  
 
End Sub

{quote}{login=Hugo}{date=28.09.2010 09:40}{thema=}{post}В смысле идентичен результату расширенного фильтра, и это всё ответ n1 :){/post}{/quote}  
hugo огромное спасибо все как надо  
есть один вопрос  
при тестировании оказалось что при заполнении всего листа записями т.е.с 1 по 65536 строку включительно ваш макрос выводит только одну строку, если записей хоть на одну меньше или в любом месте данных нет то все нормально.  
тест в файле формат xls  
 
фильтр работает при этом объеме данных(65536 стр) примерно в два раза быстрее(визуально), но и ваш макрос шустрый однако :)

Это я знаю. Но на практике не часто бывает 65536 записей...