ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Помогите довести до ума поиск одинаковых строк.
13 сообщений из 13, страница 1 из 1
Помогите довести до ума поиск одинаковых строк.
    #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, 16: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, 17:56
| Ответить | Цитировать | Написать  
Помогите довести до ума поиск одинаковых строк.
    #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:06
| Ответить | Цитировать | Написать  
Помогите довести до ума поиск одинаковых строк.
    #35176742
Dimon111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Dimon111
Участник
Забыл добавить, что у меня был один лист в книге. Я создал второй, но это не помогло. Сейчас попробуюс нумерацией листов.

Спасибо.
...
Рейтинг: 0 / 0
06.03.2008, 18:08
| Ответить | Цитировать | Написать  
Помогите довести до ума поиск одинаковых строк.
    #35176749
Dimon111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Dimon111
Участник
Не помогло...
...
Рейтинг: 0 / 0
06.03.2008, 18:09
| Ответить | Цитировать | Написать  
Помогите довести до ума поиск одинаковых строк.
    #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, 18:33
| Ответить | Цитировать | Написать  
Помогите довести до ума поиск одинаковых строк.
    #35177011
Dimon111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Dimon111
Участник
Это текстовые строки названий аудиокниг и их аторов. Просто на листе Excel организованы в 2 колонки.
...
Рейтинг: 0 / 0
06.03.2008, 20:28
| Ответить | Цитировать | Написать  
Помогите довести до ума поиск одинаковых строк.
    #35177016
Dimon111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Dimon111
Участник
Код: plaintext
1.
shRez.Cells(nRow,  1 ).Value = CStr(Vars1.Value) & vbCrLf

Не помогло. Та же ошибка. Сорри.
...
Рейтинг: 0 / 0
06.03.2008, 20:36
| Ответить | Цитировать | Написать  
Помогите довести до ума поиск одинаковых строк.
    #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:38
| Ответить | Цитировать | Написать  
Помогите довести до ума поиск одинаковых строк.
    #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, 13:54
| Ответить | Цитировать | Написать  
Помогите довести до ума поиск одинаковых строк.
    #35178524
Dimon111
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Dimon111
Участник
Все работает, о чем я и писал в предыдущем писме. Спасибо.
...
Рейтинг: 0 / 0
07.03.2008, 15:02
| Ответить | Цитировать | Написать  
Помогите довести до ума поиск одинаковых строк.
    #35178562
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Игорь Горбонос
Участник
> Автор: Dimon111
> Все работает, о чем я и писал в предыдущем писме. Спасибо.

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

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


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