Коллеги, помогите пожалуйста разобраться ..
Пишу макрос, который
1) открывает файлы excel через диалоговое окно
2) вставляет название этих файлов в столбец 1 на лист 1 рабочей книги,
3) при условии, если ячейки в этих файлах залиты определенным цветом, значение этих ячеек последовательно вставляет на лист 1 рабочей книги в разные столбцы (2,3,4)
4) закрывает открытые файлы
Всего у меня в есть ячейки закрашенные тремя цветами .
Код работает нормально для двух цветов 65535 и 15921906 , при попытке добавить цикл по третьему цвету 16247773 код начинает работать некорректно
- не закрывает открытые файлы и вставляет в столбец 4 значение ячеек с цветом 16247773,
при проверки кода построчно значение переменной r = emty ..
Код макроса всего привожу ниже, часть кода, который я добавляю для цвета 16247773 выделил красным , если его убрать все работает нормально..
Не могу понять в чем ошибка .. полагаю что то не так с циклом For
Sub CombineanWBrenameSH1()
Dim FilesToOpen
Dim x As Integer
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="All files (*.*), *.*", _
MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "не выбрано ни одного файла!"
Exit Sub
End If
x = 1
While x <= UBound(FilesToOpen)
Set c = Workbooks.Open(Filename:=FilesToOpen(x))
wbname = c.Name
ThisWorkbook.Sheets("Лист1").Cells(x + 1, 1).Value = wbname
For Each cell In Range("A1:N5000")
If cell.Interior.Color = 65535 Then
v = cell.Value
ThisWorkbook.Sheets("Лист1").Cells(x + 1, 3).Value = v
Exit For
End If
Next
For Each cell In Range("A1:N5000")
If cell.Interior.Color = 15921906 Then
n = cell.Value
ThisWorkbook.Sheets("Лист1").Cells(x + 1, 2).Value = n
Exit For
End If
Next
For Each cell In Range("A1:N5000")
If cell.Interior.Color = 16247773 Then
r = cell.Value
ThisWorkbook.Sheets("Лист1").Cells(x + 1, 4).Value = r
c.Close savechanges:=False
End If
Next
x = x + 1
Wend
Application.ScreenUpdating = True
Пишу макрос, который
1) открывает файлы excel через диалоговое окно
2) вставляет название этих файлов в столбец 1 на лист 1 рабочей книги,
3) при условии, если ячейки в этих файлах залиты определенным цветом, значение этих ячеек последовательно вставляет на лист 1 рабочей книги в разные столбцы (2,3,4)
4) закрывает открытые файлы
Всего у меня в есть ячейки закрашенные тремя цветами .
Код работает нормально для двух цветов 65535 и 15921906 , при попытке добавить цикл по третьему цвету 16247773 код начинает работать некорректно
- не закрывает открытые файлы и вставляет в столбец 4 значение ячеек с цветом 16247773,
при проверки кода построчно значение переменной r = emty ..
Код макроса всего привожу ниже, часть кода, который я добавляю для цвета 16247773 выделил красным , если его убрать все работает нормально..
Не могу понять в чем ошибка .. полагаю что то не так с циклом For
Sub CombineanWBrenameSH1()
Dim FilesToOpen
Dim x As Integer
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="All files (*.*), *.*", _
MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "не выбрано ни одного файла!"
Exit Sub
End If
x = 1
While x <= UBound(FilesToOpen)
Set c = Workbooks.Open(Filename:=FilesToOpen(x))
wbname = c.Name
ThisWorkbook.Sheets("Лист1").Cells(x + 1, 1).Value = wbname
For Each cell In Range("A1:N5000")
If cell.Interior.Color = 65535 Then
v = cell.Value
ThisWorkbook.Sheets("Лист1").Cells(x + 1, 3).Value = v
Exit For
End If
Next
For Each cell In Range("A1:N5000")
If cell.Interior.Color = 15921906 Then
n = cell.Value
ThisWorkbook.Sheets("Лист1").Cells(x + 1, 2).Value = n
Exit For
End If
Next
For Each cell In Range("A1:N5000")
If cell.Interior.Color = 16247773 Then
r = cell.Value
ThisWorkbook.Sheets("Лист1").Cells(x + 1, 4).Value = r
c.Close savechanges:=False
End If
Next
x = x + 1
Wend
Application.ScreenUpdating = True