VPF::[VBA] Поиск по файлу Excel - Форум программистов

xpvit

Дата 16.10.2006, 17:06 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 38
Регистрация: 10.10.2006

Репутация: нет
Всего: 1

Есть Файл Excel, представляет собой таблицу наименований. Один из столбцов содержит уникальный ключ наименования. Необходимо написать макрос поиска по этому ключу по всей таблице. То есть я ввожу Ключ а программа выдаёт мне строку в которой этот ключ имеет соответствующее значение. Неплохо бы что бы программа искала все строки с таким значением, вероятно ведь что закралась ошибка и чтобы она выдавала обе строки или более. Но теоретически такая строчка одна.

xpvit

Дата 17.10.2006, 07:43 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 38
Регистрация: 10.10.2006

Репутация: нет
Всего: 1

Вот вроде как-то навоял сам.

Код


Private Sub CommandButton1_Click()
Dim addr As String
    addr = "A"
Dim addr1 As String
addr1 = "AY"
Dim key As String
key = TextBox1.Text
Dim xList As Integer
Dim MyRange As Range
Dim DestRange As Range
Set DestRange = Range("A1:AY1")
        Dim s1 As String
        s1 = ""
    For x = 1 To 65000
        Dim s As String
        s = addr + LTrim(Str(x))
        If Range(s) = key Then s1 = s1 + addr + LTrim(Str(x)) + ":" + addr1 + LTrim(Str(x)) + ","
    Next x
    Set MyRange = Range(s1)
    MyRange.Select
    Set DestRange = Range("A20")
    MyRange.Copy
    DestRange.PasteSpecial
End Sub

Но остаються вопросы:
1. Как из s1 удалить последнюю запятую восле выхода из цикла иначе выкидывает ошибку.
2. Как открыть новый лист и вывести эти строчки именно туда??

xpvit

Дата 19.10.2006, 11:46 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 38
Регистрация: 10.10.2006

Репутация: нет
Всего: 1

Короче Проблема решена собственноручно -головно. Если кому интересно то вот код:

Код


Private Sub CommandButton1_Click()
Sheets("Лист2").Select
Cells.Select
Selection.ClearContents
Sheets("Лист1").Select
Dim addr As String
    addr = "A"
Dim addr1 As String
addr1 = "AY"
Dim key As String
key = TextBox1.Text
Dim xList As Integer
Dim MyRange As Range
        Dim s1 As String
        s1 = ""
    For x = 1 To 65000
        Dim s As String
        s = addr + LTrim(Str(x))
        If Range(s) = key Then s1 = s1 + addr + LTrim(Str(x)) + ":" + addr1 + LTrim(Str(x)) + ","
    Next x
    If s1 <> "" Then s1 = Left(s1, Len(s1) - 1)
    If s1 <> "" Then Set MyRange = Range(s1)
    If s1 <> "" Then MyRange.Select
    If s1 <> "" Then MyRange.Copy
    If s1 <> "" Then Sheets("Лист2").Select
    If s1 <> "" Then ActiveSheet.Paste Else MsgBox ("Netu")
End Sub

Сразу скажу о недостатках своего кода:
1. Незнаю как выполнять блочно команды после If ..... Then поэтому столько Ifов.
Ну и немного о том как действует: Выборка идёт с Лист1 по колонке A и все подошедшие нам строчки выкидываються на Лист2.
Всем спасибо за участие :-)

Alexeis

Дата 19.10.2006, 13:26 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 23
Всего: 459

xpvit, Модератор: решенные вопросы необходимо помечать, установив галочку "Пометить как решённый"

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »