» Excel VBA (часть 2)

vasiliy74
Что-то вроде этого:

Код:
Private Sub CommandButton1_Click()
Dim in_r As Range, out_r As Range
Dim index As Long, found As Boolean
Dim c1 As Variant, c2 As Variant
index = 1

' Входной диапазон на листе со внешним именем "Лист1" A:A
Set in_r = Worksheets("Лист1").Range("A:A")
' Выходной диапазон на листе со внешним именем "Лист1" B:B
Set out_r = Worksheets("Лист1").Range("B:B")

For Each c1 In in_r.Cells

found = False
For Each c2 In out_r.Cells
If IsEmpty(c2) Then Exit For
found = (c2.Value = c1.Value)
If found Then Exit For
Next c2

If Not found Then
out_r.Cells(index, 1).Value = c1.Value
index = index + 1

End If

If IsEmpty(c1) Then Exit For
Next c1

MsgBox "Done", vbInformation

End Sub

vasiliy74

Цитата:

как из столбца выбрать все уникальные значения и записать их на отдельный лист, виде коротго столбца с этими уникальными значениями

1) поищите в данном форуме - подобные решения здесь были НЕ ОДИН РАЗ!

2) наводящие вопросы:
Вы именно макросом на VBA это хотите сделать?
Столбец, в котором исходные значения - отсортирован по ним?
Переносить нужно только один столбце (в строке больше нет нужных данных)?

пока лучший вариант, который я вижу — с использованием Коллекции - [more]
цитата из данного форума:

---

Автор: vzbzdnov, Отправлено:07:47 11-01-2007

---

К вопросу выборки уникальных значений - проще и быстрее всего завести Collection и добавлять элементы по ключу, а потом читать всё подряд

Dim UnqArray As New Collection, rng, val
LastRow = Sheets("Sheet1").Range("A65536").End(xlUp).Row
On Error Resume Next ' позаботимся о dup keys
For Each rng In Sheets("Sheet1").Range("A1:A" & LastRow)
val=rng.value
UnqArray.Add Item:=val, key:=CStr(val) ' dup keys не добавятся
Next rng

For Each val in UnqArray.Item
.....
Next val
[/more]


Добавлено:

nick7inc - опередил... ;-))) плохо несколько дел делать одновременно... везде опоздаешь... ;-))

nick7inc
Спасибо, а если диапозон определяется не явно. т.е.
1 находится нужная таблица по названию столбца потом шагаю вниз на две ячейки и получаю начало столбца это вроде делается, как мне от него плясать ведь тут уксзывается Set in_r = Worksheets("Лист1").Range("A:A") понятно, наименование листа я меняю а вот Range? да мне нужно до конца, т.е. до первой пустой ячейке в столбце.

Добавлено:
SERGE_BLIZNUK
Видимо невнимательно искал в печатном виде, сорри
А вообще концепция: значения не сортированы, значение столбца необходимого для обработки не явное, то куда это будет скидываться это временная таблица, переменную массив не стал искать так как не силён в VB решил создать лист спрятать его, и туда список уникальных значений потом по этому списку буду создавать листы с такими же именами и в них выносить данные из исходной таблицы по уникальному признаку из "временного" листа где я храню этот список, затем раскидав данные по листам мне нужно будет сформировать на каждом сводный отчёт предварительно отсортировав по дополнительным параметрам.

vasiliy74

Цитата:

да мне нужно до конца, т.е. до первой пустой ячейке в столбце.

Алгоритм сам ищет пустую ячейку. Укажи диапазон до низу, например:

Код:
Dim last_cell As Long
With Worksheets("Лист1")
last_cell = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set in_r = Range(.Cells(2, "A"), .Cells(last_cell, "A"))
' или так:
' Set in_r = Range(.Cells(2, 1), .Cells(last_cell, 1))
End With

вторая строка With Worksheets("Лист1") можно заменить на ActiveWindow.SelectedSheets? я поменял, но он ругается на
Цитата:

last_cell = .Cells.SpecialCells(xlCellTypeLastCell).Row

наверно .Cells не нравиться


Добавлено:
да и без изменений он чего то не выводит, но ошибок нет, а есть ли возможность пошагово посмотреть чего он выполняет?

Добавлено:
Set in_r = Range(.Cells(2, "A"), .Cells(last_cell, "A")) наверно стоит вотак попробовать как вы в варианте написали?: Set in_r = Range(.Cells(2, 1), .Cells(last_cell, 1))

vasiliy74
Правильно ругается. Алгоритм работает с одним листом, а ты ему коллекцию пихаешь.

Делай цикл:

Dim s1 as variant '(или лучше worksheet)
for each s1 in ActiveWindow.SelectedSheets
[...]
next s1

Лучше избегать Selected или сразу его приобразовать к коллекции Worksheets и выбирать от туда по одному Worksheet. Понятнее будет.

А что будет, если в выделении не WorkSheet будет, а Chart? Надо тип по-хорошему проверять (Typename() ).

vasiliy74

Цитата:

наверно стоит вотак попробовать как вы в варианте написали

Пишите, как вам удобнее. Мне иногда через буквы удобнее колонку задавать, а иногда - через индексы.

нет не помогло, вобщем вот я стоб на нужном столбце

Код:
Sub GeniralМакрос()
'ищем значение по наименованию столбцп так как таблицы две останавливаемся на втором
Cells.Find(What:="Наименование цен", After:=ActiveCell, LookIn _
:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Cells.FindNext(After:=ActiveCell).Activate
' MsgBox "Нашли начальную ячейку"
'создаём временный лист в котором будет храниться список бумаг и скрываем его
'!Необходимо будет сделать проверку на существование подобного листа
Sheets.Add.Name = "Список"
ActiveWindow.SelectedSheets.Visible = False
Range.Next.Cells
ActiveCell.Offset(3, 0).Select
Dim in_r As Range, out_r As Range
Dim index As Long, found As Boolean
Dim c1 As Variant, c2 As Variant
index = 1

' Входной диапазон на листе со внешним именем "Лист1" A:A изменил
Dim last_cell As Long
With Worksheets("OTCHET")
last_cell = .Cells.SpecialCells(xlCellTypeLastCell).Row
'Set in_r = Range(.Cells(2, "A"), .Cells(last_cell, "A"))
' или так:
Set in_r = Range(.Cells(2, 1), .Cells(last_cell, 1))
End With
' Выходной диапазон на листе со внешним именем "СписокБумаг" A:A
Set out_r = Worksheets("Список").Range("A:A")

For Each c1 In in_r.Cells

found = False
For Each c2 In out_r.Cells
If IsEmpty(c2) Then Exit For
found = (c2.Value = c1.Value)
If found Then Exit For
Next c2

If Not found Then
out_r.Cells(index, 1).Value = c1.Value
index = index + 1

End If

If IsEmpty(c1) Then Exit For
Next c1

MsgBox "Done", vbInformation
End Sub

vasiliy74
Я бы вынес тот код, что я тебе прислал в отдельную Sub:

Sub ASearch(in_r as Range, out_r as range)
...
[more=Пример]
Private Sub ASearch(in_r as Range, out_r as Range)

Dim index As Long, found As Boolean
Dim c1 As Variant, c2 As Variant
index = 1

For Each c1 In in_r.Cells

found = False
For Each c2 In out_r.Cells
If IsEmpty(c2) Then Exit For
found = (c2.Value = c1.Value)
If found Then Exit For
Next c2

If Not found Then
out_r.Cells(index, 1).Value = c1.Value
index = index + 1

End If

If IsEmpty(c1) Then Exit For
Next c1

'MsgBox "Done", vbInformation

End Sub
[/more]

А в твоей программе правильно сделать эти объекты типа Range. Иначе сложно читать твой код.

сдел так, заработало,

Код:
' Входной диапазон на листе со внешним именем "Лист1" A:A изменил
Dim last_cell As Long
With Worksheets("OTCHET")
last_cell = .Cells.SpecialCells(xlCellTypeLastCell).Row
'Set in_r = Range(.Cells(2, "A"), .Cells(last_cell, "A"))
' или так:
' Set in_r = Range(.Cells(2, 1), .Cells(last_cell, 1))
Set in_r = Range(ActiveCell, .Cells(last_cell, 1))
End With

vasiliy74

Цитата:

Set in_r = Range(ActiveCell, .Cells(last_cell, 1))

Некорректно. Ты можешь вычислить номера столбца и строки верхней ячейки исходного диапазона?


Цитата:

а как вызвать отдельный Sub из текущего?

Код: Set in_r = ...
Set out_r = ...

ASearch in_r, out_r

я понимаю что неправельно гружу данные в с1

Добавлено:
nick7inc
если преобразовать ActiveCell то да а так незнаю даже я нахожу его по признаку столбца так как на листе несколько таблиц

Добавлено:

Цитата:

Цитата:а как вызвать отдельный Sub из текущего?

Код:Set in_r = ...
Set out_r = ...

ASearch in_r, out_r

вообще не понял

vasiliy74

Цитата:

Cells.Find(What:="Наименование цен", After:=ActiveCell, LookIn _
:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Cells.FindNext(After:=ActiveCell).Activate

Сложно понять, что код делает. У тебя поиск начинается с ActiveCell, которая может быть где угодно. Это во-первых. Во-вторых, зачем тебе активировать результат поиска, когда ты можешь его получить в объект типа Range?

Код:
Dim search_result as range
Dim Start_search as range
Dim some_sheet as worksheet

set some_sheet=worksheets("Имя")
set Start_search=some_sheet.cells(1,"A")

set search_result=Cells.Find(What:="Наименование цен", After:=Start_search, LookIn _
:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)

set search_result= Cells.FindNext(After:=search_result)

Код: ActiveCell.colum

vasiliy74

Цитата:

это номер столбца а строки пока не могу найти

ActiveCell.Row

Я чуток код поменял, посмотри выше.

да лучше начинать с начала листа верно например так да?
Код: After:=Range(1, 1)

vasiliy74
Выше посмотри. А вообще ActiveCell тот же самый объект типа Range. Но им пользоваться надо осторожно, поскольку он себя ведёт в ряде случаев непредсказуемо (или, по крайней мере, медленно). Лучше создавать свои объекты Range и ими пользоваться. В результате написанного кода ты получишь объект search_result, из которого ты можешь получить номер строки и столбца:

search_result.row
search_result.column

По-моему, Range будет состоять из одной ячейки. Посмотри search_result.rows.count и search_result.columns.count. Должно получиться по 1.

поиск понятнее только не то ищет, ему нужно найти второе значение Наименование цен на листе, Cells.FindNext(After:=ActiveCell).Activate а затем сместица на две ячейки вниз чбы встать на начало я делал ActiveCell.Offset(3, 0).Select

vasiliy74
Пожалуйста по-подробнее. Кусок кода с поиском, что возвращает в Range?

Set search_result = Cells.FindNext(After:=search_result) сорри не увидел чего то сразу сижу разбираюсь

Добавлено:
search_result = search_result.Offset(3, 0) вот так будет правильный сдвиг?

Добавлено:
Set in_r = Range(search_result, .Cells(last_cell, 1)) - это меняем так?


Цитата:

Пожалуйста по-подробнее. Кусок кода с поиском, что возвращает в Range?

возращает значение начала столбца из корого будет составлятся уникальный список,

А можно список в переменую а не на лист присвоить?

Добавлено:
search_result = search_result.Offset(3, 0) нет это он мне значение ячейки в шапку присваивает, а как изменить просто search_result.Offset(3, 0).Select ?

Цитата:

Set in_r = Range(search_result, .Cells(last_cell, 1)) - это меняем так?

Я бы сделал через Offset и как предложил SERGE_BLIZNUK:
set search=search_result.offset(...)
Set in_r = Range(search_result, search_result.End(xlDown))

Тебе на сколько и куда надо отступить от найденной ячейки?

на 3 в низ это будет начало колонки set search=search_result.offset(3,0) верно?

vasiliy74
Вообще-то:
set search_result=search_result.offset(3,0)
Отладчиком поставь Breakpoint на строчку до и после этой и посмотри значение search_result.address .

Пользуйся отладчиком почаще.

Set in_r = Range(search, .Cells(last_cell, search.Colum)) так?

Добавлено:
меню debug и F9 ?

Попробуй. А чем не нравится мой вариант? Проверь, чтобы last_cell считался из обрабатываемого листа.

last_cell устраивает только колонку нужно определить а то подгружает соседние напимер у тебя стоит 1 хотя на самом деле столбец второй и он задан явно а не взят из найденой позиции переменной search

Цитата:

меню debug и F9 ?

Да, и ещё Add Watch

Не, я про это:

set search=search_result.offset(3,0)
Set in_r = Range(search_result, search_result.End(xlDown))

там пустые ячейки между шапкой поэтому прыгаем на 3 вниз
и тогда Set in_r = Range(search, search.End(xlDown)) наверно вот так будет?

Да.

да работает и нравиться этап 1 завершон, теперь буду создавать листы с именами из этого списка рациональнее наверно сразу в цикл воткнуть??



Код:
For Each c2 In out_r.Cells
If IsEmpty(c2) Then Exit For
found = (c2.Value = c1.Value)
Sheets.Add.Name = c1.Value
If found Then Exit For
Next c2

SERGE_BLIZNUK

Файл загрузил на http://slil.ru/24641927 но вготовом виде.
получилось с поролем! Ура