Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Поиск в файлах из папки - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск в файлах из папки (Макросы/Sub)
Поиск в файлах из папки
Фомулист Дата: Четверг, 24.06.2021, 14:54 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 308
Репутация: 8 ±
Замечаний: 60% ±

Excel 2003
Здравствуйте.
Пишу с помощью форума макрос для поиска данных ячейках файлов *. xls в другой папке. Вроде написал код, но дальше запроса информации для поиска дело не идёт. Помогите, пожалуйста.
Код:
[vba]
Код
Private Function GetValue(path, file, sheet, ref)
Dim arg As String
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "Файл не найден"
Exit Function
End If
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function
Sub Найти_документы()
Const AddrresCell = 4
Dim p As String 'Директория файлов
Dim f As String 'Имя файла
Dim s As String 'Имя листа
Dim a As String 'Адрес ячейки
Dim Rng As Range, Sht As Worksheet
Dim d&, i&, g&, h&
'Вызываем диалоговое окно для определения папки с файлами
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Укажите папку, в которой находятся файлы"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Отменено" 'Прекращение работы
Else
PName = .SelectedItems(1) 'Получение пути

'Считаем количество файлов в папке для создания массива названий файлов
FName = Dir(PName & "\*.xls") 'Получаем имя первого файла
FQuant = 0 'обнуляем кол-во файлов
' Цикл подсчета кол-ва файлов
Do Until FName = "" 'Пока имя файла не станет пустым
FQuant = FQuant + 1 'Счетчик кол-ва
FName = Dir 'Получение следующего имени файла
Loop
'Заполняем массив названиями файлов
ReDim arr(1 To FQuant) As String 'Задание размерности массива на основе кол-ва файлов
FName = Dir(PName & "\*.xls") 'Получаем имя первого файла
N = 0 'обнуляем счетчик
' Цикл заполнения массива именами файлов
Do Until FName = "" 'Пока имя файла не станет пустым
N = N + 1 'Счетчик размерности массива
arr(N) = FName 'Заполнение ячейки массива
FName = Dir 'Получение следующего имени файла
Loop
N = 0
'Цикл перебора файлов
For N = 1 To FQuant
    p = PName & "\" 'Директория файлов
    f = arr(N) 'получаем имя файла
    s = Left(arr(N), Len(arr(N)) - 5) 'получаем имя листа
    On Error Resume Next
    Windows(f).Activate
    For Each Sht In ActiveWorkbook.Sheets 'цикл по всем листам в файле
        d = InputBox("Что ищем?")
        If d = "" Then Exit Sub
        Set Rng = Sht.Cells.Find(d, , xlFormulas, xlWhole) 'xlWhole - ячейка целиком, xlPart - часть ячейки
        If Not Rng Is Nothing Then 'если нашли
            'MsgBox "Найдено на листе " & Rng.Parent.Name & " в ячейке " & Rng.Address(0, 0), vbInformation, "Конец"
            For Each Cell In Rng
                     g = Rng.Adress.Row
                     h = Rng.Adress.Column
                     If Range(g + 5, h).Value <> "Да" Or Range(g + 5, h).Value <> "ДА" Or Range(g + 5, h).Value <> "да" Then
                        For i = 1 To Rng
                            If Range(g, h) = Range("D", h) Then
                    Range("B" & i).Value = Range(g - 3, h).Value
                    Range("C" & i).Value = Range(g - 1, h).Value
                    Range("D" & i).Value = Range(g + 2, h).Value
                    Range("E" & i).Value = Range(g + 3, h).Value
                            ElseIf Range(g, h) = Range("H", h) Then
                    Range("B" & i).Value = Range(g - 4, h).Value
                    Range("C" & i).Value = Range(g + 1, h).Value
                    Range("D" & i).Value = Range(g + 4, h).Value
                    Range("E" & i).Value = Range(g + 3, h).Value
                            End If
                        Next i
                    End If
            Next Cell
        End If
    Next Sht
    If Rng Is Nothing Then 'если не нашли
       GoTo Metka
    End If
Metka:
Next N
     If Rng Is Nothing Then 'если не нашли
        MsgBox "Не найдено ни на одном листе!", vbExclamation, "Конец"
     End If
End If
End With
End Sub
[/vba]


Терпение и труд всё перетрут!

Сообщение отредактировал Фомулист - Четверг, 24.06.2021, 14:58
 
Ответить
СообщениеЗдравствуйте.
Пишу с помощью форума макрос для поиска данных ячейках файлов *. xls в другой папке. Вроде написал код, но дальше запроса информации для поиска дело не идёт. Помогите, пожалуйста.
Код:
[vba]
Код
Private Function GetValue(path, file, sheet, ref)
Dim arg As String
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "Файл не найден"
Exit Function
End If
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function
Sub Найти_документы()
Const AddrresCell = 4
Dim p As String 'Директория файлов
Dim f As String 'Имя файла
Dim s As String 'Имя листа
Dim a As String 'Адрес ячейки
Dim Rng As Range, Sht As Worksheet
Dim d&, i&, g&, h&
'Вызываем диалоговое окно для определения папки с файлами
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Укажите папку, в которой находятся файлы"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Отменено" 'Прекращение работы
Else
PName = .SelectedItems(1) 'Получение пути

'Считаем количество файлов в папке для создания массива названий файлов
FName = Dir(PName & "\*.xls") 'Получаем имя первого файла
FQuant = 0 'обнуляем кол-во файлов
' Цикл подсчета кол-ва файлов
Do Until FName = "" 'Пока имя файла не станет пустым
FQuant = FQuant + 1 'Счетчик кол-ва
FName = Dir 'Получение следующего имени файла
Loop
'Заполняем массив названиями файлов
ReDim arr(1 To FQuant) As String 'Задание размерности массива на основе кол-ва файлов
FName = Dir(PName & "\*.xls") 'Получаем имя первого файла
N = 0 'обнуляем счетчик
' Цикл заполнения массива именами файлов
Do Until FName = "" 'Пока имя файла не станет пустым
N = N + 1 'Счетчик размерности массива
arr(N) = FName 'Заполнение ячейки массива
FName = Dir 'Получение следующего имени файла
Loop
N = 0
'Цикл перебора файлов
For N = 1 To FQuant
    p = PName & "\" 'Директория файлов
    f = arr(N) 'получаем имя файла
    s = Left(arr(N), Len(arr(N)) - 5) 'получаем имя листа
    On Error Resume Next
    Windows(f).Activate
    For Each Sht In ActiveWorkbook.Sheets 'цикл по всем листам в файле
        d = InputBox("Что ищем?")
        If d = "" Then Exit Sub
        Set Rng = Sht.Cells.Find(d, , xlFormulas, xlWhole) 'xlWhole - ячейка целиком, xlPart - часть ячейки
        If Not Rng Is Nothing Then 'если нашли
            'MsgBox "Найдено на листе " & Rng.Parent.Name & " в ячейке " & Rng.Address(0, 0), vbInformation, "Конец"
            For Each Cell In Rng
                     g = Rng.Adress.Row
                     h = Rng.Adress.Column
                     If Range(g + 5, h).Value <> "Да" Or Range(g + 5, h).Value <> "ДА" Or Range(g + 5, h).Value <> "да" Then
                        For i = 1 To Rng
                            If Range(g, h) = Range("D", h) Then
                    Range("B" & i).Value = Range(g - 3, h).Value
                    Range("C" & i).Value = Range(g - 1, h).Value
                    Range("D" & i).Value = Range(g + 2, h).Value
                    Range("E" & i).Value = Range(g + 3, h).Value
                            ElseIf Range(g, h) = Range("H", h) Then
                    Range("B" & i).Value = Range(g - 4, h).Value
                    Range("C" & i).Value = Range(g + 1, h).Value
                    Range("D" & i).Value = Range(g + 4, h).Value
                    Range("E" & i).Value = Range(g + 3, h).Value
                            End If
                        Next i
                    End If
            Next Cell
        End If
    Next Sht
    If Rng Is Nothing Then 'если не нашли
       GoTo Metka
    End If
Metka:
Next N
     If Rng Is Nothing Then 'если не нашли
        MsgBox "Не найдено ни на одном листе!", vbExclamation, "Конец"
     End If
End If
End With
End Sub
[/vba]

Автор - Фомулист
Дата добавления - 24.06.2021 в 14:54
Serge_007 Дата: Четверг, 24.06.2021, 15:47 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 14333
Репутация: 2368 ±
Замечаний: ±

Excel 2010
Цитата Фомулист, 24.06.2021 в 14:54, в сообщении № 1 ()
макрос для поиска данных ячейках файлов *. xls в другой папке
Что это?

Цитата Фомулист, 24.06.2021 в 14:54, в сообщении № 1 ()
Помогите, пожалуйста
Помощь здесь


Яндекс-деньги:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
Цитата Фомулист, 24.06.2021 в 14:54, в сообщении № 1 ()
макрос для поиска данных ячейках файлов *. xls в другой папке
Что это?

Цитата Фомулист, 24.06.2021 в 14:54, в сообщении № 1 ()
Помогите, пожалуйста
Помощь здесь

Автор - Serge_007
Дата добавления - 24.06.2021 в 15:47
Фомулист Дата: Четверг, 24.06.2021, 16:07 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 308
Репутация: 8 ±
Замечаний: 60% ±

Excel 2003
Что это?

Мне нужен макрос, который искал бы заданное в inputbox слово во всех файлах в заданной папке и выписывал бы в книгу значение соседней ячейки с ячейкой, в которой он нашёл искомое слово. Я пробовал написать (код в стартпост), но он почему-то не работает.
Помогите, пожалуйста.


Терпение и труд всё перетрут!

Сообщение отредактировал Фомулист - Четверг, 24.06.2021, 16:15
 
Ответить
Сообщение
Что это?

Мне нужен макрос, который искал бы заданное в inputbox слово во всех файлах в заданной папке и выписывал бы в книгу значение соседней ячейки с ячейкой, в которой он нашёл искомое слово. Я пробовал написать (код в стартпост), но он почему-то не работает.
Помогите, пожалуйста.

Автор - Фомулист
Дата добавления - 24.06.2021 в 16:07
Фомулист Дата: Четверг, 24.06.2021, 16:37 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 308
Репутация: 8 ±
Замечаний: 60% ±

Excel 2003
Помощь здесь

Почитал по ссылке и... ничего не понял. Не понимаю как связаны код по ссылке и мой код?


Терпение и труд всё перетрут!
 
Ответить
Сообщение
Помощь здесь

Почитал по ссылке и... ничего не понял. Не понимаю как связаны код по ссылке и мой код?

Автор - Фомулист
Дата добавления - 24.06.2021 в 16:37
Serge_007 Дата: Четверг, 24.06.2021, 16:53 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 14333
Репутация: 2368 ±
Замечаний: ±

Excel 2010
Цитата Фомулист, 24.06.2021 в 16:37, в сообщении № 4 ()
как связаны код по ссылке и мой код?
Ваш код взят из темы по ссылке. В той же теме по ссылке его скорректировали до рабочего состояния


Яндекс-деньги:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
Цитата Фомулист, 24.06.2021 в 16:37, в сообщении № 4 ()
как связаны код по ссылке и мой код?
Ваш код взят из темы по ссылке. В той же теме по ссылке его скорректировали до рабочего состояния

Автор - Serge_007
Дата добавления - 24.06.2021 в 16:53
Фомулист Дата: Четверг, 24.06.2021, 17:14 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 308
Репутация: 8 ±
Замечаний: 60% ±

Excel 2003
Serge_007,
Вовсе нет.
Код я писал сам.
Использовал коды с Планеты эксель. И я по ссылке не очень понял пока.


Терпение и труд всё перетрут!
 
Ответить
СообщениеSerge_007,
Вовсе нет.
Код я писал сам.
Использовал коды с Планеты эксель. И я по ссылке не очень понял пока.

Автор - Фомулист
Дата добавления - 24.06.2021 в 17:14
Serge_007 Дата: Четверг, 24.06.2021, 17:25 | Сообщение № 7
Группа: Админы
Ранг: Местный житель
Сообщений: 14333
Репутация: 2368 ±
Замечаний: ±

Excel 2010
Цитата Фомулист, 24.06.2021 в 17:14, в сообщении № 6 ()
Код я писал сам
:) :D yes

Цитата Фомулист, 24.06.2021 в 17:14, в сообщении № 6 ()
Использовал коды с Планеты эксель
Может. Но по ссылке тот же код


Яндекс-деньги:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
Цитата Фомулист, 24.06.2021 в 17:14, в сообщении № 6 ()
Код я писал сам
:) :D yes

Цитата Фомулист, 24.06.2021 в 17:14, в сообщении № 6 ()
Использовал коды с Планеты эксель
Может. Но по ссылке тот же код

Автор - Serge_007
Дата добавления - 24.06.2021 в 17:25
InExSu Дата: Пятница, 25.06.2021, 00:50 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 624
Репутация: 94 ±
Замечаний: 0% ±

Excel 2010
Привет!

Пора упрощать код.
Полезно сделать(заяндить) отдельные методы(функции, процедуры) для получения/выполнения одного дела:
- название каталога
- строка поиска
- смещение (строк, столбцов)
- на какой лист класть результат
- список файлов
- коллекция листов
- коллекция диапазонов
- цикл поиска по диапазонам
поиск по диапазону
обработка результата поиска по диапазону

Видите сколько работы?
А ещё нужно обрабатывать ошибки - то файл не откроется, то лист защищён ...


На сохранение второго закона термодинамики: яндекс.кошелёк 410012113235839
 
Ответить
СообщениеПривет!

Пора упрощать код.
Полезно сделать(заяндить) отдельные методы(функции, процедуры) для получения/выполнения одного дела:
- название каталога
- строка поиска
- смещение (строк, столбцов)
- на какой лист класть результат
- список файлов
- коллекция листов
- коллекция диапазонов
- цикл поиска по диапазонам
поиск по диапазону
обработка результата поиска по диапазону

Видите сколько работы?
А ещё нужно обрабатывать ошибки - то файл не откроется, то лист защищён ...

Автор - InExSu
Дата добавления - 25.06.2021 в 00:50
Фомулист Дата: Пятница, 25.06.2021, 12:53 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 308
Репутация: 8 ±
Замечаний: 60% ±

Excel 2003
Код я поправил, теперь он выглядит так:
[vba]
Код
Private Function GetValue(path, file, sheet, ref)
Dim arg As String
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "Файл не найден"
Exit Function
End If
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function
Sub Найти_документы()
Const AddrresCell = 4
Dim p As String 'Директория файлов
Dim f As String 'Имя файла
Dim s As String 'Имя листа
Dim a As String 'Адрес ячейки
Dim Rng As Range, Sht As Worksheet
Dim i&, g&, h&
'Вызываем диалоговое окно для определения папки с файлами
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Укажите папку, в которой находятся файлы"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Отменено" 'Прекращение работы
Else
PName = .SelectedItems(1) 'Получение пути

'Считаем количество файлов в папке для создания массива названий файлов
FName = Dir(PName & "\*.xls") 'Получаем имя первого файла
FQuant = 0 'обнуляем кол-во файлов
' Цикл подсчета кол-ва файлов
Do Until FName = "" 'Пока имя файла не станет пустым
FQuant = FQuant + 1 'Счетчик кол-ва
FName = Dir 'Получение следующего имени файла
Loop
'Заполняем массив названиями файлов
ReDim arr(1 To FQuant) As String 'Задание размерности массива на основе кол-ва файлов
FName = Dir(PName & "\*.xls") 'Получаем имя первого файла
N = 0 'обнуляем счетчик
' Цикл заполнения массива именами файлов
Do Until FName = "" 'Пока имя файла не станет пустым
N = N + 1 'Счетчик размерности массива
arr(N) = FName 'Заполнение ячейки массива
FName = Dir 'Получение следующего имени файла
Loop
N = 0
'Цикл перебора файлов
d = InputBox("Что ищем?")
If IsNull(d) Then Exit Sub
For N = 1 To FQuant
    p = PName & "\" 'Директория файлов
    f = arr(N) 'получаем имя файла
    s = Left(arr(N), Len(arr(N)) - 5) 'получаем имя листа
    On Error Resume Next
    Set WB = Application.Workbooks.Open(p & f)
    WB.Activate
    For Each Sht In WB.Sheets 'цикл по всем листам в файле
        Set Rng = Sht.Cells.Find(d, , xlFormulas, xlWhole) 'xlWhole - ячейка целиком, xlPart - часть ячейки
        If Not Rng Is Nothing Then 'если нашли
            'MsgBox "Найдено на листе " & Rng.Parent.Name & " в ячейке " & Rng.Address(0, 0), vbInformation, "Конец"
            For Each Cell In Rng
                     g = Rng.Adress.Row
                     h = Rng.Adress.Column
                     If Range(g + 5, h).Value <> "Да" Or Range(g + 5, h).Value <> "ДА" Or Range(g + 5, h).Value <> "да" Then
                        For i = 1 To Rng
                            If Range(g, h) = Range("D", h) Then
                    MsgBox (Workbooks(f).Range(g - 3, h).Value)
                    Workbooks("Поиск.xlsm").Range("B" & i).Value = Workbooks(f).Range(g - 3, h).Value
                    Workbooks("Поиск.xlsm").Range("C" & i).Value = Workbooks(f).Range(g - 1, h).Value
                    Workbooks("Поиск.xlsm").Range("D" & i).Value = Workbooks(f).Range(g + 2, h).Value
                    Workbooks("Поиск.xlsm").Range("E" & i).Value = Workbooks(f).Range(g + 3, h).Value
                            ElseIf Range(g, h) = Range("H", h) Then
                    Workbooks("Поиск.xlsm").Range("B" & i).Value = Workbooks(f).Range(g - 4, h).Value
                    Workbooks("Поиск.xlsm").Range("C" & i).Value = Workbooks(f).Range(g + 1, h).Value
                    Workbooks("Поиск.xlsm").Range("D" & i).Value = Workbooks(f).Range(g + 4, h).Value
                    Workbooks("Поиск.xlsm").Range("E" & i).Value = Workbooks(f).Range(g + 3, h).Value
                            End If
                        Next i
                    End If
            Next Cell
        End If
    Next Sht
    If Rng Is Nothing Then 'если не нашли
       GoTo Metka
    End If
Metka:
WB.Close
Next N
     If Rng Is Nothing Then 'если не нашли
        MsgBox "Не найдено ни на одном листе!", vbExclamation, "Конец"
     End If
End If
End With
End Sub
[/vba]
Но на деле кусок кода после [vba]
Код
For each cell in rng
[/vba]
почему-то не выполняется. Помогите, пожалуйста.


Терпение и труд всё перетрут!
 
Ответить
СообщениеКод я поправил, теперь он выглядит так:
[vba]
Код
Private Function GetValue(path, file, sheet, ref)
Dim arg As String
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "Файл не найден"
Exit Function
End If
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function
Sub Найти_документы()
Const AddrresCell = 4
Dim p As String 'Директория файлов
Dim f As String 'Имя файла
Dim s As String 'Имя листа
Dim a As String 'Адрес ячейки
Dim Rng As Range, Sht As Worksheet
Dim i&, g&, h&
'Вызываем диалоговое окно для определения папки с файлами
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Укажите папку, в которой находятся файлы"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Отменено" 'Прекращение работы
Else
PName = .SelectedItems(1) 'Получение пути

'Считаем количество файлов в папке для создания массива названий файлов
FName = Dir(PName & "\*.xls") 'Получаем имя первого файла
FQuant = 0 'обнуляем кол-во файлов
' Цикл подсчета кол-ва файлов
Do Until FName = "" 'Пока имя файла не станет пустым
FQuant = FQuant + 1 'Счетчик кол-ва
FName = Dir 'Получение следующего имени файла
Loop
'Заполняем массив названиями файлов
ReDim arr(1 To FQuant) As String 'Задание размерности массива на основе кол-ва файлов
FName = Dir(PName & "\*.xls") 'Получаем имя первого файла
N = 0 'обнуляем счетчик
' Цикл заполнения массива именами файлов
Do Until FName = "" 'Пока имя файла не станет пустым
N = N + 1 'Счетчик размерности массива
arr(N) = FName 'Заполнение ячейки массива
FName = Dir 'Получение следующего имени файла
Loop
N = 0
'Цикл перебора файлов
d = InputBox("Что ищем?")
If IsNull(d) Then Exit Sub
For N = 1 To FQuant
    p = PName & "\" 'Директория файлов
    f = arr(N) 'получаем имя файла
    s = Left(arr(N), Len(arr(N)) - 5) 'получаем имя листа
    On Error Resume Next
    Set WB = Application.Workbooks.Open(p & f)
    WB.Activate
    For Each Sht In WB.Sheets 'цикл по всем листам в файле
        Set Rng = Sht.Cells.Find(d, , xlFormulas, xlWhole) 'xlWhole - ячейка целиком, xlPart - часть ячейки
        If Not Rng Is Nothing Then 'если нашли
            'MsgBox "Найдено на листе " & Rng.Parent.Name & " в ячейке " & Rng.Address(0, 0), vbInformation, "Конец"
            For Each Cell In Rng
                     g = Rng.Adress.Row
                     h = Rng.Adress.Column
                     If Range(g + 5, h).Value <> "Да" Or Range(g + 5, h).Value <> "ДА" Or Range(g + 5, h).Value <> "да" Then
                        For i = 1 To Rng
                            If Range(g, h) = Range("D", h) Then
                    MsgBox (Workbooks(f).Range(g - 3, h).Value)
                    Workbooks("Поиск.xlsm").Range("B" & i).Value = Workbooks(f).Range(g - 3, h).Value
                    Workbooks("Поиск.xlsm").Range("C" & i).Value = Workbooks(f).Range(g - 1, h).Value
                    Workbooks("Поиск.xlsm").Range("D" & i).Value = Workbooks(f).Range(g + 2, h).Value
                    Workbooks("Поиск.xlsm").Range("E" & i).Value = Workbooks(f).Range(g + 3, h).Value
                            ElseIf Range(g, h) = Range("H", h) Then
                    Workbooks("Поиск.xlsm").Range("B" & i).Value = Workbooks(f).Range(g - 4, h).Value
                    Workbooks("Поиск.xlsm").Range("C" & i).Value = Workbooks(f).Range(g + 1, h).Value
                    Workbooks("Поиск.xlsm").Range("D" & i).Value = Workbooks(f).Range(g + 4, h).Value
                    Workbooks("Поиск.xlsm").Range("E" & i).Value = Workbooks(f).Range(g + 3, h).Value
                            End If
                        Next i
                    End If
            Next Cell
        End If
    Next Sht
    If Rng Is Nothing Then 'если не нашли
       GoTo Metka
    End If
Metka:
WB.Close
Next N
     If Rng Is Nothing Then 'если не нашли
        MsgBox "Не найдено ни на одном листе!", vbExclamation, "Конец"
     End If
End If
End With
End Sub
[/vba]
Но на деле кусок кода после [vba]
Код
For each cell in rng
[/vba]
почему-то не выполняется. Помогите, пожалуйста.

Автор - Фомулист
Дата добавления - 25.06.2021 в 12:53
InExSu Дата: Пятница, 25.06.2021, 14:39 | Сообщение № 10
Группа: Проверенные
Ранг: Ветеран
Сообщений: 624
Репутация: 94 ±
Замечаний: 0% ±

Excel 2010
Цитата Фомулист, 25.06.2021 в 12:53, в сообщении № 9 ()
кусок кода после
For each cell in rng
почему-то не выполняется.

Может после
[vba]
Код
Set Rng = Sht.Cells.Find ...
[/vba]
в Rng получается Nothng ?

Можете описать словами что Вы хотели начиная со строки:
[vba]
Код
If Range(g + 5, h).Value <> "Да" Or ...
[/vba]
?


На сохранение второго закона термодинамики: яндекс.кошелёк 410012113235839
 
Ответить
Сообщение
Цитата Фомулист, 25.06.2021 в 12:53, в сообщении № 9 ()
кусок кода после
For each cell in rng
почему-то не выполняется.

Может после
[vba]
Код
Set Rng = Sht.Cells.Find ...
[/vba]
в Rng получается Nothng ?

Можете описать словами что Вы хотели начиная со строки:
[vba]
Код
If Range(g + 5, h).Value <> "Да" Or ...
[/vba]
?

Автор - InExSu
Дата добавления - 25.06.2021 в 14:39
Фомулист Дата: Пятница, 25.06.2021, 15:06 | Сообщение № 11
Группа: Проверенные
Ранг: Обитатель
Сообщений: 308
Репутация: 8 ±
Замечаний: 60% ±

Excel 2003
в Rng получается Nothng ?

Почему? И как это исправить?
Можете описать словами что Вы хотели начиная со строки

Хотел, если в столбце на 5 столбцов правее столбца, в котором нашли заданное слово, не написано Да в любом регистре, то берём значения из столбцов, которые вычисляют я указаниям в строках ниже строки, указанной в Вашей цитате из предыдущего поста и записываем их в ячейки файла, указанннве во всё тех же строках кода.
Помогите, пожалуйста.


Терпение и труд всё перетрут!
 
Ответить
Сообщение
в Rng получается Nothng ?

Почему? И как это исправить?
Можете описать словами что Вы хотели начиная со строки

Хотел, если в столбце на 5 столбцов правее столбца, в котором нашли заданное слово, не написано Да в любом регистре, то берём значения из столбцов, которые вычисляют я указаниям в строках ниже строки, указанной в Вашей цитате из предыдущего поста и записываем их в ячейки файла, указанннве во всё тех же строках кода.
Помогите, пожалуйста.

Автор - Фомулист
Дата добавления - 25.06.2021 в 15:06
InExSu Дата: Пятница, 25.06.2021, 15:20 | Сообщение № 12
Группа: Проверенные
Ранг: Ветеран
Сообщений: 624
Репутация: 94 ±
Замечаний: 0% ±

Excel 2010
Не, не понятно.


На сохранение второго закона термодинамики: яндекс.кошелёк 410012113235839
 
Ответить
СообщениеНе, не понятно.

Автор - InExSu
Дата добавления - 25.06.2021 в 15:20
Фомулист Дата: Пятница, 25.06.2021, 15:26 | Сообщение № 13
Группа: Проверенные
Ранг: Обитатель
Сообщений: 308
Репутация: 8 ±
Замечаний: 60% ±

Excel 2003
Не, не понятно

Что именно?


Терпение и труд всё перетрут!
 
Ответить
Сообщение
Не, не понятно

Что именно?

Автор - Фомулист
Дата добавления - 25.06.2021 в 15:26
InExSu Дата: Пятница, 25.06.2021, 15:35 | Сообщение № 14
Группа: Проверенные
Ранг: Ветеран
Сообщений: 624
Репутация: 94 ±
Замечаний: 0% ±

Excel 2010
Вы пытаетесь объяснить код, ссылками на этот же код, да ещё с очепятками.
Всё Ваше объяснения непонятно.


На сохранение второго закона термодинамики: яндекс.кошелёк 410012113235839
 
Ответить
СообщениеВы пытаетесь объяснить код, ссылками на этот же код, да ещё с очепятками.
Всё Ваше объяснения непонятно.

Автор - InExSu
Дата добавления - 25.06.2021 в 15:35
Фомулист Дата: Пятница, 25.06.2021, 15:51 | Сообщение № 15
Группа: Проверенные
Ранг: Обитатель
Сообщений: 308
Репутация: 8 ±
Замечаний: 60% ±

Excel 2003
Код должен выполнять поиск указанного мной слова. Если нашёл, - смотреть, есть ли в крайней справа колонке таблицы, в которой нашлось слово, ДА в любом регистре, если нет - выписать значения некоторых столбцов этой таблицы в файл, откуда был запущен макрос. Помогите, пожалуйста.


Терпение и труд всё перетрут!

Сообщение отредактировал Фомулист - Пятница, 25.06.2021, 15:53
 
Ответить
СообщениеКод должен выполнять поиск указанного мной слова. Если нашёл, - смотреть, есть ли в крайней справа колонке таблицы, в которой нашлось слово, ДА в любом регистре, если нет - выписать значения некоторых столбцов этой таблицы в файл, откуда был запущен макрос. Помогите, пожалуйста.

Автор - Фомулист
Дата добавления - 25.06.2021 в 15:51
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск в файлах из папки (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования Jobsora jooble
© 2010-2021 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!