Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Помогите довести до ума поиск одинаковых строк. / 13 сообщений из 13, страница 1 из 1
06.03.2008, 16:56
    #35176418
Dimon111
Dimon111
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите довести до ума поиск одинаковых строк.
Результат поиска сейчас выводится в два текстовых окна. Надо создать новый лист и вывести туда эти результаты. В две колонки.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
'------------------------------Поиск одинаковых строк------------------------------
Private Sub ServiceButton_Click()           'Поиск одинаковых строк:
Dim Serv As Range, Vars As Variant          '
Set Serv = Range("C1:C2086")                'Диапазон - шаблон для сравнения
For Each Vars In Serv                       'Цикл для каждого элемента
With Worksheets( 1 ).Range("C2089:C2533")     'Диапазон сравниваемых величин. 
    Set c = .Find(Vars, LookIn:=xlValues)   'Поиск очередного элемента (Vars)
    If Not c Is Nothing Then                '
        FirstAddress = c.Address            'Если элемент найден, присвоить адрес переменной firstAddress
        Do                                  '
            TextBox1 = TextBox1 & c.Value & vbCrLf  'Вывод найденного элемента в текстовое окно (название рассказа)
            TextBox2.Text = TextBox2.Text & Vars & vbCrLf  'TextBox2.Text & CStr(Cells(c.Row, c.Column - 2).Value) & vbCrLf 'Вывод автора
            Set c = .FindNext(c)                    'следующий поиск
        Loop While Not c Is Nothing And c.Address <> FirstAddress 'Критерий окончания цикла: продолжать пока
    End If                                          'не найден пустой элемент и адрес поиска не перескочил на начало
End With                                            '
Next Vars                                           '
End Sub                                             '

Может у кого появится минутка помочь?

Спасибо.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
06.03.2008, 17:56
    #35176689
Игорь Горбонос
Игорь Горбонос
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите довести до ума поиск одинаковых строк.
"Dimon111" <nospam@sql.ru>; сообщил/сообщила в новостях следующее:
news:5381561@sql.ru...
> Автор: Dimon111
> Результат поиска сейчас выводится в два текстовых окна. Надо создать
> новый лист и вывести туда эти результаты. В две колонки.
>
>

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
'------------------------------Поиск одинаковых 
строк------------------------------
Private Sub ServiceButton_Click()           'Поиск одинаковых строк:
Dim Serv As Range, Vars As Variant          '
Dim nRow As Long                            'Номер активной строки на новом 
листе
Dim shRez As Worksheet                      'Лист результат
Set Serv = Range("C1:C2086")                'Диапазон - шаблон для сравнения
nRow =  1                                     'Начинать будем с первой строки
Set shRez = Worksheets( 2 )
For Each Vars In Serv                       'Цикл для каждого элемента
With Worksheets( 1 ).Range("C2089:C2533")     'Диапазон сравниваемых величин.
    Set c = .Find(Vars, LookIn:=xlValues)   'Поиск очередного элемента 
(Vars)
    If Not c Is Nothing Then                '
        FirstAddress = c.Address            'Если элемент найден, присвоить 
адрес переменной firstAddress
        Do                                  '
            shRez.Cells(nRow, 1 ).Value = TextBox1.Text & c.Value & vbCrLf 
'Вывод найденного элемента в текстовое окно (название рассказа)
            shRez.Cells(nRow, 2 ).Value = TextBox2.Text & Vars & vbCrLf 
'TextBox2.Text & CStr(Cells(c.Row, c.Column - 2).Value) & vbCrLf 'Вывод 
автора
            nRow = nRow +  1                          'переходим на новую 
строку
            Set c = .FindNext(c)                    'следующий поиск
        Loop While Not c Is Nothing And c.Address <> FirstAddress 'Критерий 
окончания цикла: продолжать пока
    End If                                          'не найден пустой 
элемент и адрес поиска не перескочил на начало
End With                                            '
Next Vars                                           '
End Sub                                             '

>
> Может у кого появится минутка помочь?
>
> Спасибо.
э-хэ-хэ-хэ-хэх :(

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
06.03.2008, 18:06
    #35176736
Dimon111
Dimon111
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите довести до ума поиск одинаковых строк.
Получаю ошибку Application defind or object defind error в строке
Код: plaintext
1.
shRez.Cells(nRow,  1 ).Value = Vars1 & vbCrLf

Программа поиска несколько изменилась. Я отказался от Find - слишком примитивно. Но смысл остается:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
Dim Ishodnoe As Range, Vars1 As Variant, Sveryaemoe As Range, Vars2 As Variant  '

Dim shRez As Worksheet
Set shRez = Worksheets( 2 )

Set Ishodnoe = Range("C1:C2086")            'Диапазон - шаблон для сравнения
Set Sveryaemoe = Range("C2089:C2533")       'Диапазон - шаблон для сравнения
For Each Vars1 In Ishodnoe                  'Внешний цикл
    If Len(Vars1) <  2  Then GoTo  77           'Короткие строки не обрабатывать
    For Each Vars2 In Sveryaemoe            'Внутренний цикл
        If Len(Vars2) >  2  And InStr(Vars1, Vars2) >  0  Then
            TextBox2 = TextBox2 & Vars1 & vbCrLf
            shRez.Cells(nRow,  1 ).Value = Vars1 & vbCrLf
            shRez.Cells(nRow,  2 ).Value = Vars2 & Vars & vbCrLf
        End If
    Next Vars2                              'Внутренний цикл
DoEvents                                    'Вывод в промежутках между циклами
 77 : Next Vars1                              'Внешний цикл

Прошу прощения, если ввел вас в заблуждение своими изменениями, но смысл кажется не поменялся.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
06.03.2008, 18:08
    #35176742
Dimon111
Dimon111
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите довести до ума поиск одинаковых строк.
Забыл добавить, что у меня был один лист в книге. Я создал второй, но это не помогло. Сейчас попробуюс нумерацией листов.

Спасибо.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
06.03.2008, 18:09
    #35176749
Dimon111
Dimon111
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите довести до ума поиск одинаковых строк.
Не помогло...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
06.03.2008, 18:33
    #35176793
Игорь Горбонос
Игорь Горбонос
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите довести до ума поиск одинаковых строк.
> Автор: Dimon111
> Получаю ошибку Application defind or object defind error в строке

сделай так, да и можно отказатся от вариантов в пользу Range, как ты это
начал делать
> shRez.Cells(nRow, 1).Value = CStr(Vars1.Value) & vbCrLf
> Программа поиска несколько изменилась. Я отказался от Find - слишком
> примитивно. Но смысл остается:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
Dim Ishodnoe As Range, Vars1 As Variant, Sveryaemoe As Range, Vars2 
As Variant  '

Dim shRez As Worksheet
Set shRez = Worksheets( 2 )

Set Ishodnoe = Range("C1:C2086")            'Диапазон - шаблон для сравнения
Set Sveryaemoe = Range("C2089:C2533")       'Диапазон - шаблон для сравнения
For Each Vars1 In Ishodnoe                  'Внешний цикл
    If Len(Vars1) >  2  Then                  'Короткие строки не обрабатывать
        For Each Vars2 In Sveryaemoe            'Внутренний цикл
            If Len(Vars2) >  2  And InStr(Vars1, Vars2) >  0  Then
                TextBox2 = TextBox2 & Vars1 & vbCrLf
                shRez.Cells(nRow,  1 ).Value = Vars1 & vbCrLf
                shRez.Cells(nRow,  2 ).Value = Vars2 & Vars & vbCrLf
            End If
        Next Vars2                              'Внутренний цикл
        DoEvents                                'Вывод в промежутках между 
циклами
    EndIf
Next Vars1                              'Внешний цикл

> Прошу прощения, если ввел вас в заблуждение своими изменениями, но
> смысл кажется не поменялся.

А можешь дать пример своих данных?
Мне кажется через SQL запрос это будет быстрее отрабатывать

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
06.03.2008, 20:28
    #35177011
Dimon111
Dimon111
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите довести до ума поиск одинаковых строк.
Это текстовые строки названий аудиокниг и их аторов. Просто на листе Excel организованы в 2 колонки.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
06.03.2008, 20:36
    #35177016
Dimon111
Dimon111
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите довести до ума поиск одинаковых строк.
Код: plaintext
1.
shRez.Cells(nRow,  1 ).Value = CStr(Vars1.Value) & vbCrLf

Не помогло. Та же ошибка. Сорри.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.03.2008, 13:38
    #35178276
Dimon111
Dimon111
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите довести до ума поиск одинаковых строк.
Программирование невнимательности не прощает. Я допустил ошибки. Конечно же ваш код работал.

Ошибки исправлены и я сделал то, что хотел. Вам большое спасибо.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
'------------------------------Поиск одинаковых строк------------------------------
Private Sub ServiceButton_Click()           'Поиск одинаковых строк:
Dim Ishodnoe As Range, Vars1 As Variant, Sveryaemoe As Range, Vars2 As Variant,  nRow As Integer
nRow =  1 
Set Ishodnoe = Worksheets( 1 ).Range("C1:C2086")      'Диапазон - шаблон для сравнения
Set Sveryaemoe = Worksheets( 1 ).Range("C2089:C2533") '
For Each Vars1 In Ishodnoe                  'Внешний цикл
    If Len(Vars1) <  2  Then GoTo  77           'Короткие строки не обрабатывать
    For Each Vars2 In Sveryaemoe            'Внутренний цикл
        If Len(Vars2) >  2  And InStr(Vars1, Vars2) >  0  Then
            TextBox2 = TextBox2 & Vars1 & vbCrLf
            Worksheets( 2 ).Cells(nRow,  1 ).Value = CStr(Vars1.Value)
            Worksheets( 2 ).Cells(nRow,  2 ).Value = CStr(Vars2.Value)
            nRow = nRow +  1                  '
        End If                              '
    Next Vars2                              'Внутренний цикл
'DoEvents                                   'Вывод в промежутках между циклами
 77 : Next Vars1                              'Внешний цикл
End Sub                                     '
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.03.2008, 13:54
    #35178324
Игорь Горбонос
Игорь Горбонос
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите довести до ума поиск одинаковых строк.
> Автор: Dimon111
> shRez.Cells(nRow, 1).Value = CStr(Vars1.Value) & vbCrLf
> Не помогло. Та же ошибка. Сорри.

Значит проверяй на то что shRez не Nothing и Vars1 не Nothing или Empty, и 0
< nRow < 65537


Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.03.2008, 15:02
    #35178524
Dimon111
Dimon111
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите довести до ума поиск одинаковых строк.
Все работает, о чем я и писал в предыдущем писме. Спасибо.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.03.2008, 15:18
    #35178562
Игорь Горбонос
Игорь Горбонос
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите довести до ума поиск одинаковых строк.
> Автор: Dimon111
> Все работает, о чем я и писал в предыдущем писме. Спасибо.

я хотел спросить а что было-то?

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
07.03.2008, 23:33
    #35179253
Dimon111
Dimon111
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите довести до ума поиск одинаковых строк.
Забыл про nRow = 1 и nRow = nRow + 1.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Помогите довести до ума поиск одинаковых строк. / 13 сообщений из 13, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 416ms
Закрыть
start [/forum/topic.php?fid=60&mobile=1&tid=2162565]:
 0ms
get settings:
 10ms
get forum list:
 20ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 60ms
get topic data:
 10ms
get forum data:
 2ms
get page messages:
 59ms
get tp. blocked users:
 1ms
others: 248ms
total:  416ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]