Добрый день. Помогите пожалуйста, неожиданно понадобилась следующая функция.
В столбике А находятся номера (формат общий, но скорее всего будет текст). В папке "C:\\DOC" находятся файлы с расширением pdf, с такими же названиями, как в столбике А.
Мне нужно, что бы макрос проверял по названиям наличие файлов в папке и если находил, то в столбике Б (напротив названия из столбика А) писал "Есть" и закрашивал ячейку зелёным цветом, если не нашёл файл, то писал "Нет" и закрашивал красным цветом.
Пример:
А Б
23565896 Есть 23578963 Нет 13547765 Нет 65656566 Есть
Очень буду ждать Вашей помощи.
Добрый день. Помогите пожалуйста, неожиданно понадобилась следующая функция.
В столбике А находятся номера (формат общий, но скорее всего будет текст). В папке "C:\\DOC" находятся файлы с расширением pdf, с такими же названиями, как в столбике А.
Мне нужно, что бы макрос проверял по названиям наличие файлов в папке и если находил, то в столбике Б (напротив названия из столбика А) писал "Есть" и закрашивал ячейку зелёным цветом, если не нашёл файл, то писал "Нет" и закрашивал красным цветом.
Пример:
А Б
23565896 Есть 23578963 Нет 13547765 Нет 65656566 Есть
Function FileYesNo(a As Range) If Dir("C:\\DOC\" & a & ".pdf") = "" Then FileYesNo = "Нет" Else FileYesNo = "Есть" End If End Function
[/vba]апдэйт: я конечно же не дочитал [vba]
Код
Sub u_700() Application.ScreenUpdating = False u = "C:\\DOC\" v = Cells(Rows.Count, "a").End(xlUp).Row For Each w In Range("a1:a" & v) If Dir(u & w & ".pdf") = "" Then w.Offset(0, 1) = "Нет" w.Offset(0, 1).Interior.Color = 255 Else w.Offset(0, 1) = "Есть" w.Offset(0, 1).Interior.Color = 5296274 End If Next Application.ScreenUpdating = True End Sub
[/vba]
[vba]
Код
Function FileYesNo(a As Range) If Dir("C:\\DOC\" & a & ".pdf") = "" Then FileYesNo = "Нет" Else FileYesNo = "Есть" End If End Function
[/vba]апдэйт: я конечно же не дочитал [vba]
Код
Sub u_700() Application.ScreenUpdating = False u = "C:\\DOC\" v = Cells(Rows.Count, "a").End(xlUp).Row For Each w In Range("a1:a" & v) If Dir(u & w & ".pdf") = "" Then w.Offset(0, 1) = "Нет" w.Offset(0, 1).Interior.Color = 255 Else w.Offset(0, 1) = "Есть" w.Offset(0, 1).Interior.Color = 5296274 End If Next Application.ScreenUpdating = True End Sub
Гениально! Спасибо Вам огромное. Столько время и нервов мне сэкономили. Раз уж я тут, есть ещё маленький вопрос Ничего сложного, может уже ест где то в темах.
Например в столбике А попадается одинаковый текст. Можно сделать так, что бы ячейки с одинаковым текстом перекрашивались в красный, автоматически, без кнопки, допустим после каждого ввода происходила проверка ?
Пример А 132356 165416 132356
Это бы мне тоже очень помогло:)
Гениально! Спасибо Вам огромное. Столько время и нервов мне сэкономили. Раз уж я тут, есть ещё маленький вопрос Ничего сложного, может уже ест где то в темах.
Например в столбике А попадается одинаковый текст. Можно сделать так, что бы ячейки с одинаковым текстом перекрашивались в красный, автоматически, без кнопки, допустим после каждого ввода происходила проверка ?
Это называется Условное форматирование Главная - УФ - Правила выделения ячейки - Повторяющиеся значения Только не делайте УФ на весь столбец сразу. С запасом - да, но не сильно много, а то подвисать будет
Добавлено Что-то я прозевал. В правилах что написано? Один вопрос - одна тема. В следующий раз новые вопросы в новых темах задавайте
Это называется Условное форматирование Главная - УФ - Правила выделения ячейки - Повторяющиеся значения Только не делайте УФ на весь столбец сразу. С запасом - да, но не сильно много, а то подвисать будет
Добавлено Что-то я прозевал. В правилах что написано? Один вопрос - одна тема. В следующий раз новые вопросы в новых темах задавайте_Boroda_
Private Sub Worksheet_Change(ByVal Target As Range) u = Target.Column If u = 1 Then a = Target.Value b = Target.Row c = Application.Match(a, Range("a1:a" & b - 1)) If IsNumeric(c) Then Target.Interior.Color = 255 End If End Sub
[/vba]апдэйт: опять не дочитал. в этот раз сооб. выше
в модуль листа[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) u = Target.Column If u = 1 Then a = Target.Value b = Target.Row c = Application.Match(a, Range("a1:a" & b - 1)) If IsNumeric(c) Then Target.Interior.Color = 255 End If End Sub
[/vba]апдэйт: опять не дочитал. в этот раз сооб. вышеNic70y
Скрипт показывает результат только до определённой строки. И в каждом файле по разному, иногда не доходит 133 до самого конца со значениями в столбике иногда 33. Я пыталась указать как пример range a1:a50000 выдаёт ошибку. Файлы имеют по 50 тыс. строк. Как сделать, что бы скрипт точно доходил до конца?
Скрипт показывает результат только до определённой строки. И в каждом файле по разному, иногда не доходит 133 до самого конца со значениями в столбике иногда 33. Я пыталась указать как пример range a1:a50000 выдаёт ошибку. Файлы имеют по 50 тыс. строк. Как сделать, что бы скрипт точно доходил до конца?DKR
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
