код vba

КОЛОНА (С:С) ИМА ЗАПИСИ КОЙТО СЕ ПОВТАРЯТ,ИМА И ПРАЗНИ КЛЕТКИ. ОПИТВАМ СЕ ДА НАПИША КОД С КОИТО ДА ИЗВЛЕКА В ComboBox1 НА UserForm1 САМО УНИКАЛНИТЕ ЗАПИСИ ,СОРТИРАНИ

Аз бих го направил без код, като използвам Data -> advanced filter -> отметка на Unique records only

избираш си колона в която нямаш данни
аз давам пример с колона 11 т.е. "К:К"
ето кода

Private Sub UserForm_Initialize()
Dim fl As Boolean

'
lastrow = Selection.SpecialCells(xlCellTypeLastCell).Row
For i = 1 To lastrow
fl = False
For j = 1 To i - 1
If i = 1 Then Exit For
If Cells(i, 3) = Cells(j, 3) Then

fl = True
Exit For
End If
Next
If fl = False Then
r = r + 1
Cells(r, 11) = Cells(i, 3)
End If
Next

Columns("K:K").Select
Selection.Sort Key1:=Range("K1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

For i = 1 To lastrow
ComboBox1.AddItem Cells(i, 11)
If Cells(i, 11) = "" And i <> 1 Then Exit For
Next

Columns("K:K").Select
Selection.ClearContents



End Sub

Ето и един вариант, който използвам, при който се използва collection:

Public Sub RemoveDuplicates()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
Dim LastRow As Long




LastRow = Range("C65536").End(xlUp).Row

Set AllCells = Range(Cells(1, 3),Cells(LastRow, 3))

' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we want!


On Error Resume Next


For Each Cell In AllCells

If Not IsEmpty(Cell) Then
NoDupes.Add Cell.Value, CStr(Cell.Value)

End If


' Note: the 2nd argument (key) for the Add method must be a string


Next Cell

' Resume normal error handling
On Error GoTo 0

If NoDupes.Count > 0 Then

' Sort the collection (optional)
For i = 1 To NoDupes.count - 1
For j = i + 1 To NoDupes.count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, Before:=j
NoDupes.Add Swap2, Before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i

' Add the sorted, non-duplicated items to a ListBox





For Each Item In NoDupes
UserForm.ComboBox1.AddItem Item

Next Item

' Show the UserForm
UserForm.Show
Else
MyAlert = MsgBox("Съобщение, ако няма нищо в колекцията", 48)
End If

End Sub

Това, което е в червено, трябва да се поправи, така че да отговаря на твоите конкретнуи нужди. Тъй като поправях макрос, който използвам, надявам се че не съм допуснал неволна грешка, ако има нещо - ще гледаме къде е проблема

Geocaching в България

Бypaн БЛАГОДАРЯ !!!! ТИ СИ ВЪРХЪ НЯМАМ ДУМИ КОЛКО МИ ПОМОГНА

ТОВА С collection: НЕ МОЖАХ ДА ГО СХВАНА , МАСИВ ЛИ Е .МОЖЕ ЛИ ДА СЕ ВЪРЖИ КЪМ ПОВЕЧЕ ОТ ЕДНА КОЛОНА КЪМ ЛИСТ БОКС И ДА СЕ ФИЛТРУВА ПО КРИТЕРИЙ. МОЛЯ ТЕ КАЧИ НЯКАКВИ ПРИМЕРИ

AllCell e Област (Range), т.е. не е задължително да е колона, може да е всяка област от клетки. Колекцията (Collection) e нещо стандартно в ексел, има множество стандартни колекции - напр. Sheets, Cells, Workbooks и т.н. Потребителя може да си дефинира собствени колекции. Това е нещо подобно като масив, но не е точно същото. Казано по друг начин, това е набор от обекти от един и същ тип.

Geocaching в България

НЕ МОГА ДА ВМЪКНА НЯКОЛКО КОЛОНИ ОТ КОЛЕКЦИЯ В ЛИСТ БОКС ПО КОЛОНИ, РЕДИ МИ ГИ САМО ВПЪРВАТА КОЛОНА НА ЛИСТ БОКСА

Явно аз не те разбрах какво искаш. Помислих, че искаш да обходиш всички клетки в някъв Range и да добавиш всички стойности в комбо бокс с една колона. Дефакто ти добавяш стойността на всяка клетка в областта като елемент от колекцията. Ако правилно те разбирам, всъщност искаш да добавиш стойностити в комбо бокс с повече от една колона. Нямам нищо готово за такъв случай, ще помисля и ако измисля нещо - ще пиша. Но определено ще е доста по-сложно, заради сортировката и евентуалните празни позиции. Иначе на първо четене се сещам, че може да се направят като няколко отделни колекции, като на всяка една се добавя един и същи ключ за елементите, които са на един и същи ред и после да се извикват съответните елементи с еднакъв ключ и да се добавят към съответната колона на комбото.

Geocaching в България