Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 22.04.2010, 17:17   #1
Andr3000
 
Регистрация: 22.04.2010
Сообщений: 6
По умолчанию Поиск в листе Excel одного значения несколько раз

Здравствуйте, столкнулся с проблемой

Имеется:
1. Текстовый файл с кодами (числовые значения, в файле не повторяются)
2. Лист в MSExcel (таблица), коды в столбце "а", всего 9 столбцов, может встречаться несколько строк с одинаковым кодом (идут подряд).

Нужно: сделать еще один лист и если в таблице Excel есть код, который есть в текстовом файле, скопировать всю строку на созданный лист, причем на первой найденной строке не останавливаться, а искать дальше.

Проблема: прога находит строку, копирует ее, потом находит следующую, но копирует через одну, пропуская вторую. То есть если есть четыре строки с одним кодом, копируются 1,3,4, если три строки - то 1 и 3.

Sub код()
Dim x As Variant

m = 1
ActiveSheet.Name = "база"
Sheets.Add.Name = "расчет"

Open "d:\1\_kod.txt" For Input As #1 ' Открывает файл для чтения.
Do While Not EOF(1) ' Достигнут ли конец файла?
Line Input #1, x ' Читает строку данных.

d = 1
For i = 1 To 65536
Set c = Worksheets("база").Range("a" & d & ":" & "a" & "65536").Find(x, LookAt:=xlWhole)
If c Is Nothing Then
GoTo nd
Else
d = c.Row
Worksheets("расчет").Range("a" & m & ":" & "i" & m).Value = Worksheets("база").Range("a" & d & ":" & "i" & d).Value
m = m + 1 'на листике расчет следующая строка
d = d + 1
End If
Next i

nd:
Loop
Close #1 ' Закрывает файл.

End Sub


Если что просьба ногами в живот не бить, я начинающий, и прогу по-любому написал криво )
Только вот кривизну эту найти не могу (

PS: так как было нужно быстро, вышел из положения так: отсортировал в Excel список так, чтобы строки с одинаковыми кодами не шли подряд, выбралось все норм, но хотелось бы чтобы прога работала при любых условиях )

Последний раз редактировалось Andr3000; 22.04.2010 в 17:48.
Andr3000 вне форума Ответить с цитированием
Старый 23.04.2010, 05:08   #2
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Предлагаю сделать так:
Код:
Sub Main()
    Dim x As Range, a As String, fst As String, ts
    Application.ScreenUpdating = False: ActiveSheet.Name = "база"
    On Error Resume Next: Sheets("расчет").Delete: On Error GoTo 0
    Sheets.Add.Name = "расчет"
    Set ts = CreateObject("Scripting.FileSystemObject").OpenTextFile("D:\1\_kod.txt", 1)
    Do
        On Error Resume Next: a = ts.ReadLine
        If Err <> 0 Then Exit Do
        Set x = Sheets("база").[A:A].Find(what:=a, LookAt:=xlWhole)
        If Not x Is Nothing Then
            fst = x.Address
            Do
                Sheets("база").Rows(x.Row).Copy Rows(Cells(Rows.Count, 1).End(xlUp).Row + 1)
                Set x = Sheets("база").[A:A].FindNext(x)
            Loop While fst <> x.Address
        End If
    Loop: ts.Close
End Sub
что не понятно - спрашивайте.
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Старый 23.04.2010, 10:24   #3
Andr3000
 
Регистрация: 22.04.2010
Сообщений: 6
По умолчанию

огромное спасибо, все работает как часики )
как красиво написано, мне до такого еще далеко
насчет непонятного - сейчас в режиме отладки пошагово разберусь )
Andr3000 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поиск в листе sasha_prof Microsoft Office Excel 6 24.03.2010 19:20
Как скопировать диапазон несколько раз? Алексей11111 Microsoft Office Excel 9 19.11.2009 10:13
Не могу отобразить на одном листе несколько листов каждый из которых имеет свою сортировку данных FERRUM Microsoft Office Excel 7 03.10.2009 10:41
Как зарегистрировать несколько раз в реестре Volkogriz Общие вопросы Delphi 5 14.01.2009 16:42
Поиск в VBA Excel на листе luxery Microsoft Office Excel 1 10.11.2008 08:38