Добрый день. Помогите пожалуйста, неожиданно понадобилась следующая функция.
В столбике А находятся номера (формат общий, но скорее всего будет текст). В папке "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