Имя файла dbf при сохранении

[vadick]

Доброго времени суток.

Есть вот такой скрипт, который обрабатывает файл Excel

Sub CreateDBF()
'Отрубаем предупреждения. Иначе при сохранении будет спрашивать тупые вопросы про потерю форматирования
    Application.DisplayAlerts = False

'Открываем цикл для обработки каждого листа. Цикл отрабатывает до количества листов (Sheets.Count)
    Dim Sum As Double, Count As Integer
    Sum = 0
    For Count = 1 To Sheets.Count
    Sum = Sum + 1

'Делаем проверку (1). Если сумма заказа в ячейке А1 не равна нулю - запускается следующая проверка
'Нужна для того, чтобы не обрабатывался лист без заказа
    If Sheets(Sum).Cells(1, 1).Value <> "0" Then
   
'Еще одна проверка (2). Если - ячейка А1 пустая то не запускается обработка листа.
'Нужна для листа на котором есть служебная инфа и нет заказа
    If Sheets(Sum).Cells(1, 1).Value <> "" Then
   
'Активируем лист
    Sheets(Sum).Activate

'Блок удаления ненужных строк и столбцов
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp

    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
   
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
   
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
   
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
   
'Блок удаления позиций с нулевым значением заказа
    Dim sSubStr As String 'выставляем символ по которому будет искать строки
    Dim lCol As Long 'номер столбца по которому искать символ
    Dim lLastRow As Long, li As Long
   
    sSubStr = "0"
    lCol = "1"
    If lCol = 0 Then Exit Sub

    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count

    Application.ScreenUpdating = 1
    For li = lLastRow To 1 Step -1
        If CStr(Cells(li, lCol)) = sSubStr Then Rows(li).Delete
    Next li
    Application.ScreenUpdating = 1
   
'Блок удаления пустых строк
    Dim sSubStr1 As String 'выставляем символ по которому будет искать строки
    Dim lCol1 As Long 'номер столбца по которому искать символ
    Dim lLastRow1 As Long, li1 As Long

    sSubStr1 = ""
    lCol1 = "1"
    If lCol1 = 0 Then Exit Sub

    lLastRow1 = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count

    Application.ScreenUpdating = 1
    For li1 = lLastRow1 To 1 Step -1
        If CStr(Cells(li1, lCol1)) = sSubStr1 Then Rows(li1).Delete
    Next li1
    Application.ScreenUpdating = 1
   
'Ставим курсор в ячейку А1. Иначе не сохраняет, поскольку выделен столбец С.
    Range("A1:A1").Select
   
'Блок сохранения листа в dbf. Сохраняет по типу: имя исходного файла + имя листа
'Сохранение происходит в ту же папку что и исходный файл
    ActiveWorkbook.SaveAs Filename:= _
    ThisWorkbook.Path & "\" & ActiveWorkbook.Name & "_" & ActiveSheet.Name & ".dbf", FileFormat:=xlDBF4 _
    , CreateBackup:=False

'Закрываем проверку (2)
    End If
   
'Закрываем проверку (1)
    End If

'Закрываем цикл
    Next Count

'Закрываем Excel, иногда висит в памяти
    Application.Quit
   
End Sub

Проблема в том, что, если на нескольких листах есть, что обрабатывать, то при сохранении dbf файла имеет вид:

"имя книги(с расширением) + имя листа1 + имя листа2 " Т.Е. был бы у меня один лист, меня бы устраивало "имя книги + имя листа"
Но почему-то если есть еще лист (второй, N-цатый) то имена листов суммируются?   

[Алексей Шмуйлович]

Очень странно. Глядя на код, такого быть не должно. А отладчиком пробовали посмотреть значение ThisWorkbook.Path & "\" & ActiveWorkbook.Name & "_" & ActiveSheet.Name & ".dbf" в момент сохранения? Откуда такое имя-то берется? Можете выложить Excel-файл?

[vadick]

Выкладываю файл.

[Алексей Шмуйлович]

Ну все понятно. Дело в том, что к моменту сохранения второго листа книга уже переименована (когда вы сохраняли первый лист). Соответственно, имя второго листа добавляется не к начальному названию, а к измененному. И так каждый раз. Лучше в начале процедуры загнать имя книги в переменную, и обращаться уже к ней, а не свойствам книги. Это и производительность повысит.
Кстати о производительности - делать activate, select, delete  и прочие ненужные телодвижения, очень неэффективно. Макрос работает крайне медленно.
Я бы на вашем месте не чистил исходный файл от ненужных данных, а обходил бы (виртуально, а не селектом) его листы и ячейки и выбирал бы нужные данные.

Вместо счетчика листов и строк используйте конструкции типа

'Виртуально перебираем все листы книги
For each Ws in ActiveWorkbook.Sheets
   'Виртуально перебираем все строки использованного диапазона каждого листа
   For each Rw in Ws.UsedRange.Rows
     
      'Проверяем соблюдение нужных условий, и если они выполняются, проводим какие-то действия с данными.
      if Rw.Cells(2) <>0 Then a=Rw.Cells(1) 'Присваиваем переменной значение первой ячейки строки Rw листа Ws.
      'Вместо переменной можно записать значение, например, в какую-то ячейку временной книги.
   Next
Next

Такой код будет работать в разы быстрее.

[vadick]

Спасибо Вам за ответ.
Честно говоря,  я его не очень понял, потому как это был мой первый опыт с макросами.
Что-то в книге прочитал, что-то додумал, и использовал.
Для меня близко select, delete, потому что работаю с базами sql.
Не могли бы Вы привести рабочую конструкцию макроса?
Я чему-то научусь.

[kuklp]

Ну например блок:

Код Выделить Развернуть

''Активируем лист
   Sheets(Sum).Activate

'Блок удаления ненужных строк и столбцов
   Rows("1:1").Select
   Selection.Delete Shift:=xlUp

   Columns("A:A").Select
   Selection.Delete Shift:=xlToLeft
   
   Columns("B:B").Select
   Selection.Delete Shift:=xlToLeft
   
   Columns("B:B").Select
   Selection.Delete Shift:=xlToLeft
   
   Columns("C:C").Select
   Selection.Delete Shift:=xlToLeft
Можно записать так:

Код Выделить Развернуть

    Sheets(Sum).Rows("1:1").Delete
   Sheets(Sum).[A:A,C:D,f:f].Delete

 

[vadick]

Спасибо всем, все получилось!