Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA. Не работает внешний цикл в вложенном цикле
 
#1
27.04.2021 06:16:25
Доброго времени суток!
Написал макрос для открытия файла в папке, удаления формул и сохранения файла.
Но не получается сделать чтоб он открывал другие папки кроме первой.
Код
Sub OpenSpis2()
Application.ScreenUpdating = False
Dim b, s, r, v, z, a, q As Variant

z = 3
r = 3
b = 3
Do While Not IsEmpty(Cells(z, 1))
a = Cells(z, 1)
Do While Not IsEmpty(Cells(r, 1))
v = Cells(r, 1).Value
Cells(3, 3).Value = v
    q = Cells(b, 2)
    s = Evaluate("=CONCATENATE(MID(CELL(""имяфайла""),1,-2+FIND(""["",CELL(""имяфайла""))),""\"")")
    pt = s & a & "\" & q & ".xlsx"
    MsgBox a
    
Application.Workbooks.Open pt
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
ActiveWorkbook.Save
ActiveWorkbook.Close SaveChanges:=False
r = r + 1
b = b + 1
Loop
z = z + 1
Loop


Application.ScreenUpdating = True
End Sub

Файл пример прилагаю.
VBA только учусь, буду благодарен любым советам с объяснениями.

P.s. MsgBox для демонстрации папки(забыл удалить).
Изменено: Dez089 - 27.04.2021 06:48:35
 
 
 
#2
27.04.2021 07:18:58
Уберите лишний цикл достаточно одного. Переменные z, r ,b тоже лишние достаточно одной из них Лишний цикл закоментировал. Переменные убирайте сами.Вы же учитесь    Сразу не понял что в каждой папке несколько файлов
Изменено: Евгений Смирнов - 27.04.2021 08:15:33
 
 
 
#3
27.04.2021 07:25:26
Евгений Смирнов, в таком случае он после выполнения первого цикла в Папке 1, переходит в Папку 2.
Т.е. Он берёт первый файл в первой папке, второй файл в второй папке и т.д.
Код
Sub OpenSpis2()
Application.ScreenUpdating = False
Dim s, r, v, a, q As Variant
r = 3
Do While Not IsEmpty(Cells(r, 1))
a = Cells(r, 1)
v = Cells(r, 1).Value
Cells(3, 3).Value = v
    q = Cells(r, 2)
    s = Evaluate("=CONCATENATE(MID(CELL(""имяфайла""),1,-2+FIND(""["",CELL(""имяфайла""))),""\"")")
    pt = s & a & "\" & q & ".xlsx"
    MsgBox a
      
Application.Workbooks.Open pt
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
ActiveWorkbook.Save
ActiveWorkbook.Close SaveChanges:=False
r = r + 1
Loop
Application.ScreenUpdating = True
End Sub
Изменено: Dez089 - 27.04.2021 07:30:18
 
 
 
#4
27.04.2021 07:51:04
Dez089,  у Dас нет иерархии при которой нужно искать что вложено , а просто список , где раздельно , и не понятно зачем, хранится папка и имя. По этому достаточно пройти по строкам и это даст имя книги с использованием относительного пути.
А вот это надj записывать так,
Код
    s = Evaluate("=CONCATENATE(MID(CELL(""filename""),1,-2+FIND(""["",CELL(""filename""))),""\"")")
иначе в другой локализации не сработает, но еще лучше просто так
Код
 s = ThisWorkbook.Path & Application.PathSeparator
По вопросам из тем форума, личку не читаю.
 
 
 
#5
27.04.2021 08:10:44
Вроде так работает
Код
Sub OpenSpis2()
Application.ScreenUpdating = False
Dim b, s, r, v, z, a, q As Variant
z = 3
r = 3
b = 3
Do While Not IsEmpty(Cells(z, 1))
a = Cells(z, 1)
Do While Not IsEmpty(Cells(r, 1))

v = Cells(r, 1).Value
Cells(3, 3).Value = v
    q = Cells(b, 2)
    s = Evaluate("=CONCATENATE(MID(CELL(""имяфайла""),1,-2+FIND(""["",CELL(""имяфайла""))),""\"")")
    pt = s & a & "\" & q & ".xlsx"
    MsgBox a
Application.Workbooks.Open pt
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
ActiveWorkbook.Save
ActiveWorkbook.Close SaveChanges:=False
r = r + 1
b = b + 1
Loop
r = 3: b = 3
z = z + 1
Loop
Application.ScreenUpdating = True
End Sub

Изменил немного код не совсем правильно написал сначала. Сейчас некогда попозже поясню




Изменено: Евгений Смирнов - 27.04.2021 08:27:47
 
 
 
#6
27.04.2021 08:14:07
Цитата
БМВ написал: А вот это надj записывать так
Спасибо, учту на будущие!

Цитата
БМВ написал: но еще лучше просто так
Тогда если переместят файл, путь надо будет переписывать заново. Но запомню, пригодится.

Евгений Смирнов, Да, всё работает! А не могли в ЛС в двух словах объяснить что было не так? Спасибо!
 
 
 
#7
27.04.2021 08:38:22
На самом деле внешний цикл работал. Но у вас <MsgBox a> во  внутреннем цикле и после его исполнения переменные r и b  выходили за диапазон и поэтому во внутренний цикл он больше не заходил. Не работал внутренний цикл
Изменено: Евгений Смирнов - 27.04.2021 08:42:26
 
 
 
#8
27.04.2021 09:23:31
Цитата
Dez089 написал:
Тогда если переместят файл
смотря какой файл. ThisWorkbook - это книга с самим кодом и ThisWorkbook.Path будет всегда указывать на ту папку, в которой расположен файл с выполняемым кодом.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
Страницы: 1
Наверх