Страницы: 1
RSS
Проверка наличия листов по списку, Проверка наличия листов по списку (перед копированием данных с этих листов)
 
Доброго времени суток.
Столкнулся с небольшой проблемкой и пока не хватает силенок ее решить самостоятельно.
Задача заключается в следующем. Есть 7 подрядчиков, которые ежедневно присылают данные для сводной таблицы. Каждый отчет подрядчика, добавляется как отдельный лист в книгу (с постоянной подписью, условно "Подрядчик 1" 2, 3 и т.д.). После добавления данные из этих листов макросом переносятся в сводную таблицу. Как прописать, чтобы перед копированием данных выполнялась проверка на наличие всех листов и если хоть один отсутствует, выводить сообщение от какого подрядчика нет данных и не запускать процесс переноса данных, пока не будут добавлены все листы. Спасибо за помощь  :)  
 
Сергей Цымбалистый,
https://www.excel-vba.ru/chto-umeet-excel/kak-uznat-sushhestvuet-li-list-v-knige/
 
ну судя по всему нужно иметь список нужных листов  Shs=array("Sheet1","Sheet2" ... ) проверка в цикле по одному из указанных методов или
application.evaluate("=ISREF("& Shs(i) &"!a1)")
. При отсутсnвии формировать строку сообщения добавляя имя отсутствующего.
По вопросам из тем форума, личку не читаю.
 
Сергей Цымбалистый, добрый день
Код
Sub mrshkei()
Dim arr, sh As Worksheet, i As Long
arr = Array("Подрядчик 1", "Подрядчик 2", "Подрядчик 3", "Подрядчик 4", "Подрядчик 5", "Подрядчик 6", "Подрядчик 7")
For i = LBound(arr) To UBound(arr)
k = 0
    For Each sh In Worksheets
        If sh.Name = arr(i) Then GoTo M
    Next sh
        If tt = "" Then
            tt = arr(i)
        Else
            tt = tt & vbLf & arr(i)
        End If
M:
Next i
If tt = "" Then
    ' ваша часть кода
Else
    MsgBox ("НЕТ ДАННЫХ ПО СЛЕДУЮЩИМ ПОДРЯДЧИКАМ:" & vbLf & vbLf & tt)
End If
End Sub
Изменено: Mershik - 07.10.2021 09:17:49
Не бойтесь совершенства. Вам его не достичь.
 
Mershik,
For i = LBound(arr) To UBound(arr) на For Each по любому можно,  так.

Код
Sub mrshkei()
Dim arr, sh As Worksheet, N As string , tt as string 
arr = Array("Подрядчик 1", "Подрядчик 2", "Подрядчик 3", "Подрядчик 4", "Подрядчик 5", "Подрядчик 6", "Подрядчик 7")
For Each N in arr
  if not application.evaluate("=ISREF("& N &"!a1)") then  tt = tt & vbLf & N
Next
If tt = "" Then
    ' ваша часть кода
Else
    MsgBox ("НЕТ ДАННЫХ ПО СЛЕДУЮЩИМ ПОДРЯДЧИКАМ:" & tt)
End If
End Sub
По вопросам из тем форума, личку не читаю.
 
evgeniygeo,благодарю. Интересные примеры. Попробую что нибудь из этого прикрутить  :)  
 
Mershik,огромное спасибо! Выглядит столь же круто как и работает  8)  Пойду учится дальше, хочу и сам так уметь )))
БМВ, и вам огромное спасибо за интересные идеи  :)  
 
Код
Sub CheckSheets()
  Dim sh, i&, ws As Worksheet, s$
  Set sh = CreateObject("Scripting.Dictionary")
  For Each ws In Worksheets: sh(ws.Name) = 0: Next
  For i = 1 To 21
    If Not sh.Exists("Подрядчик " & i) Then s = s & ", " & i
  Next
  If s <> "" Then MsgBox Right(s, Len(s) - 2), , "Отсутсвуют листы след. подрядчиков:"
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
Страницы: 1
Наверх