RAN, Огромное спасибо!!!! Все работает...Маленький штрих...Как вернуть ячейке СТ2 в новом файле имя данного файла. Например наш файл сохранился под именем Профиль(5). Мне надо чтобы в ячейке Ст2 имя Профиль стало Профиль(5), как имя сохраненного файла. Раньше у меня было что-то типа
[vba]
Код
Range("ct2")=Filename
[/vba]
в конце данного макроса. А как сейчас будет выглядеть эта строка?
RAN, Огромное спасибо!!!! Все работает...Маленький штрих...Как вернуть ячейке СТ2 в новом файле имя данного файла. Например наш файл сохранился под именем Профиль(5). Мне надо чтобы в ячейке Ст2 имя Профиль стало Профиль(5), как имя сохраненного файла. Раньше у меня было что-то типа
[vba]
Код
Range("ct2")=Filename
[/vba]
в конце данного макроса. А как сейчас будет выглядеть эта строка?Влад777
Влад777, я думал, что в ячейку у Вас сохраняется имя, причем имя предыдущего файла, поэтому казалось всё попроще: [vba]
Код
If Dir("C:\Users\Admin\Documents\Таможня\2-й этап\База\" & NameFile & ".xls") <> "" Then If IsNumeric(Right(NameFile, 1)) And Left(Right(NameFile, 2), 1) = "_" Then Do i = i + 1 NameFile = Left(NameFile, Len(NameFile) - 1) & i Loop While Dir("C:\Users\Admin\Documents\Таможня\2-й этап\База\" & NameFile & ".xls") <> "" i = 0 Else Do i = i + 1 If i = 1 Then NameFile = NameFile & "_" & i Else NameFile = Left(NameFile, Len(NameFile) - 1) & i End If Loop While Dir("C:\Users\Admin\Documents\Таможня\2-й этап\База\" & NameFile & ".xls") <> "" i = 0 End If End If
[/vba]
Влад777, я думал, что в ячейку у Вас сохраняется имя, причем имя предыдущего файла, поэтому казалось всё попроще: [vba]
Код
If Dir("C:\Users\Admin\Documents\Таможня\2-й этап\База\" & NameFile & ".xls") <> "" Then If IsNumeric(Right(NameFile, 1)) And Left(Right(NameFile, 2), 1) = "_" Then Do i = i + 1 NameFile = Left(NameFile, Len(NameFile) - 1) & i Loop While Dir("C:\Users\Admin\Documents\Таможня\2-й этап\База\" & NameFile & ".xls") <> "" i = 0 Else Do i = i + 1 If i = 1 Then NameFile = NameFile & "_" & i Else NameFile = Left(NameFile, Len(NameFile) - 1) & i End If Loop While Dir("C:\Users\Admin\Documents\Таможня\2-й этап\База\" & NameFile & ".xls") <> "" i = 0 End If End If
Windows("Пример.xlsx").Activate Set wb3 = Workbooks("Пример.xlsx") shName = wb3.ActiveSheet.Name Cells.Select Selection.Copy Workbooks.Add ActiveSheet.Paste Range("CT2").Select Application.CutCopyMode = False Selection.Copy Application.CutCopyMode = False If Dir("C:\Users\Abinov\Desktop\Новая папка\" & namefile & ".xls") <> "" Then If IsNumeric(Right(namefile, 1)) And Left(Right(namefile, 2), 1) = "_" Then Do i = i + 1 namefile = Left(namefile, Len(namefile) - 1) & i Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & namefile & ".xls") <> "" i = 0 Else Do i = i + 1 If i = 1 Then namefile = namefile & "_" & i Else namefile = Left(namefile, Len(namefile) - 1) & i End If Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & namefile & ".xls") <> "" i = 0 End If End If ActiveWorkbook.SaveAs Filename:="C:\Users\Abinov\Desktop\Новая папка\" & namefile, FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False Range("ct2") = namefile
Windows("Пример.xlsx").Activate Set wb3 = Workbooks("Пример.xlsx") shName = wb3.ActiveSheet.Name Cells.Select Selection.Copy Workbooks.Add ActiveSheet.Paste Range("CT2").Select Application.CutCopyMode = False Selection.Copy Application.CutCopyMode = False If Dir("C:\Users\Abinov\Desktop\Новая папка\" & namefile & ".xls") <> "" Then If IsNumeric(Right(namefile, 1)) And Left(Right(namefile, 2), 1) = "_" Then Do i = i + 1 namefile = Left(namefile, Len(namefile) - 1) & i Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & namefile & ".xls") <> "" i = 0 Else Do i = i + 1 If i = 1 Then namefile = namefile & "_" & i Else namefile = Left(namefile, Len(namefile) - 1) & i End If Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & namefile & ".xls") <> "" i = 0 End If End If ActiveWorkbook.SaveAs Filename:="C:\Users\Abinov\Desktop\Новая папка\" & namefile, FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False Range("ct2") = namefile
Влад777, а что пишет при ошибке? и при дебаге можете глянуть какое значение у namefile кстати, изначально задумывалось, что namefile задаётся из ячейки CT2? у Вас не вижу этого в коде. [vba]
Код
namefile = Range("CT2")
[/vba] перед самим циклом поиска уникального имени.
Влад777, а что пишет при ошибке? и при дебаге можете глянуть какое значение у namefile кстати, изначально задумывалось, что namefile задаётся из ячейки CT2? у Вас не вижу этого в коде. [vba]
Код
namefile = Range("CT2")
[/vba] перед самим циклом поиска уникального имени.Roman777
Много чего не знаю!!!!
Сообщение отредактировал Roman777 - Суббота, 26.12.2015, 13:16
Windows("Пример.xlsm").Activate Set wb3 = Workbooks("Пример.xlsm") shName = wb3.ActiveSheet.Name cells.Select Selection.Copy Workbooks.Add ActiveSheet.Paste Range("CT2").Select Application.CutCopyMode = False Selection.Copy Application.CutCopyMode = False namefile = Range("CT2") If Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> "" Then If IsNumeric(Right(NameFile, 1)) And Left(Right(NameFile, 2), 1) = "_" Then Do i = i + 1 NameFile = Left(NameFile, Len(NameFile) - 1) & i Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> "" i = 0 Else Do i = i + 1 If i = 1 Then NameFile = NameFile & "_" & i Else NameFile = Left(NameFile, Len(NameFile) - 1) & i End If Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> "" i = 0 End If End If ActiveWorkbook.SaveAs Filename:="C:\Users\Abinov\Desktop\Новая папка\" & namefile, FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False Range("ct2")=namefile ActiveWorkbook.Save
[/vba]
Ура! Все работает!! Вот такой вариант получился
[vba]
Код
Windows("Пример.xlsm").Activate Set wb3 = Workbooks("Пример.xlsm") shName = wb3.ActiveSheet.Name cells.Select Selection.Copy Workbooks.Add ActiveSheet.Paste Range("CT2").Select Application.CutCopyMode = False Selection.Copy Application.CutCopyMode = False namefile = Range("CT2") If Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> "" Then If IsNumeric(Right(NameFile, 1)) And Left(Right(NameFile, 2), 1) = "_" Then Do i = i + 1 NameFile = Left(NameFile, Len(NameFile) - 1) & i Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> "" i = 0 Else Do i = i + 1 If i = 1 Then NameFile = NameFile & "_" & i Else NameFile = Left(NameFile, Len(NameFile) - 1) & i End If Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> "" i = 0 End If End If ActiveWorkbook.SaveAs Filename:="C:\Users\Abinov\Desktop\Новая папка\" & namefile, FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False Range("ct2")=namefile ActiveWorkbook.Save
Roman777, Добрый день! Такой момент. До 10 файлы нумеруются корректно. Однако, после 10 получается такое имя, например - "НЕПОИМЕНОВАННО_111", "НЕПОИМЕНОВАННО_1112" и т.д. Не подскажите, как это исправить?
Roman777, Добрый день! Такой момент. До 10 файлы нумеруются корректно. Однако, после 10 получается такое имя, например - "НЕПОИМЕНОВАННО_111", "НЕПОИМЕНОВАННО_1112" и т.д. Не подскажите, как это исправить?Влад777
If IsNumeric(Right(NameFile, 1)) And Left(Right(NameFile, 2), 1) = "_" Then
[/vba] что-то я смотрю, и у меня получается не оч красиво. Проблема в поиске определяющиего критерия которое говорит, есть ли в имени уже цифра эта или нет =) [vba]
Код
If instr(1, NameFile, "_") >0 Then
[/vba] приношу извинения за косяки.
Влад777, Всё дело в этой фразе: [vba]
Код
If IsNumeric(Right(NameFile, 1)) And Left(Right(NameFile, 2), 1) = "_" Then
[/vba] что-то я смотрю, и у меня получается не оч красиво. Проблема в поиске определяющиего критерия которое говорит, есть ли в имени уже цифра эта или нет =) [vba]
Влад777, я ещё раз звиняюсь, всё-таки непрально Вам подсказал, вернее частично правильно. В общем получилась у меня крайне муторная и... вродебы должна работать): [vba]
Код
If Dir("C:\Users\Abinov\Desktop\Новая папка\") <> "" Then If InStr(1, StrReverse(NameFile), "_") > 0 And IsNumeric(Right(NameFile, InStr(1, StrReverse(NameFile), "_") + 1 * (InStr(1, StrReverse(NameFile), "_") > 0))) Then Do i = i + 1 NameFile = Left(NameFile, Len(NameFile) - InStr(1, StrReverse(NameFile), "_") + 1) & i Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> "" i = 0 Else Do i = i + 1 If i = 1 Then NameFile = NameFile & "_" & i Else NameFile = Left(NameFile, Len(NameFile) - InStr(1, StrReverse(NameFile), "_") + 1) & i End If Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> "" i = 0 End If End If ActiveWorkbook.SaveAs Filename:="C:\Users\Abinov\Desktop\Новая папка\" & NameFile, FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False Range("ct2") = NameFile ActiveWorkbook.Save
[/vba]
Влад777, я ещё раз звиняюсь, всё-таки непрально Вам подсказал, вернее частично правильно. В общем получилась у меня крайне муторная и... вродебы должна работать): [vba]
Код
If Dir("C:\Users\Abinov\Desktop\Новая папка\") <> "" Then If InStr(1, StrReverse(NameFile), "_") > 0 And IsNumeric(Right(NameFile, InStr(1, StrReverse(NameFile), "_") + 1 * (InStr(1, StrReverse(NameFile), "_") > 0))) Then Do i = i + 1 NameFile = Left(NameFile, Len(NameFile) - InStr(1, StrReverse(NameFile), "_") + 1) & i Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> "" i = 0 Else Do i = i + 1 If i = 1 Then NameFile = NameFile & "_" & i Else NameFile = Left(NameFile, Len(NameFile) - InStr(1, StrReverse(NameFile), "_") + 1) & i End If Loop While Dir("C:\Users\Abinov\Desktop\Новая папка\" & NameFile & ".xls") <> "" i = 0 End If End If ActiveWorkbook.SaveAs Filename:="C:\Users\Abinov\Desktop\Новая папка\" & NameFile, FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False Range("ct2") = NameFile ActiveWorkbook.Save
Roman777, день добрый! Я, честно, не виноват - оно само :)))) Теперь данный макрос ко всем именам файлов приписывает единицу На имена свыше 10 пока не могу протестировать..не попалось пока такого имени...
Roman777, день добрый! Я, честно, не виноват - оно само :)))) Теперь данный макрос ко всем именам файлов приписывает единицу На имена свыше 10 пока не могу протестировать..не попалось пока такого имени...Влад777
Влад777, Странно) у меня всё ОК. А имя какое у Вас? я проверил даже Af_a_6 тоже работает норм =) Файлик прицепил, там только переменную path измените) и можете изменить кол-во циклов... просто мб я не оч понял Вашу задачу.
Влад777, Странно) у меня всё ОК. А имя какое у Вас? я проверил даже Af_a_6 тоже работает норм =) Файлик прицепил, там только переменную path измените) и можете изменить кол-во циклов... просто мб я не оч понял Вашу задачу.Roman777