Добрый день. Как сохранять данные из ячеек в другом файле, чтобы они из формы записывались в строку таблицы, форма данных примерная, будет больше ячеек, просто хочу понять алгоритм, чтобы потом самому исправлять макрос
Добрый день. Как сохранять данные из ячеек в другом файле, чтобы они из формы записывались в строку таблицы, форма данных примерная, будет больше ячеек, просто хочу понять алгоритм, чтобы потом самому исправлять макросASWP
А куда вставлять нужно? Всегда в В3:С4 или нет? И зачем у Вас в файле База умная таблица с запасом сделана? Так не должно быть. Она на то и умная, что сама расширяться будет по мере добавления данных. Кстати, Вы бы выложили файл База в нормальном виде, а то не совсем ясно к чему цепляться при определении последней заполненной строки
А куда вставлять нужно? Всегда в В3:С4 или нет? И зачем у Вас в файле База умная таблица с запасом сделана? Так не должно быть. Она на то и умная, что сама расширяться будет по мере добавления данных. Кстати, Вы бы выложили файл База в нормальном виде, а то не совсем ясно к чему цепляться при определении последней заполненной строки_Boroda_
_Boroda_, Их надо вставить в строку, от A3 до E3, порядок пока не имеет значения. А уже при вводе других данных, чтобы они вставлялись уже в следующую строку.
_Boroda_, Их надо вставить в строку, от A3 до E3, порядок пока не имеет значения. А уже при вводе других данных, чтобы они вставлялись уже в следующую строку.ASWP
я знаю что ничего не знаю, но другие не знают и этого
Sub kopir() Dim d_ As Range 'd_ - диапазон ячеек Set d_ = Range("I12,I16,L16,I20,L20") 'каких ячеек n_ = d_.Count 'сколько их штук ReDim ar(1 To 1, 1 To n_) 'ar - массив в одну строку и n_ столбцов For i = 1 To n_ 'заполняем массив, цикл от 1 до n_ ar(1, i) = d_.Areas(i).Cells(1).Value 'i-й элемент массива по горизонтали равен 'первой ячейке каждого из поддиапазонов диапазона d_ Next i 'коней цикла Workbooks.Open Filename:=ThisWorkbook.Path & "\basa2.xlsx" 'открываем файл База, лежащий в той же папке, что и этот файл With ActiveSheet 'работаем с активным листом r1_ = .Cells(.Rows.Count, 1).End(3).Row 'от последней ячейки в столбце А прыгаем наверх '(как будто на листе из ячейки A1048576 нажали Контрл+СтрелкаВверх), попадаем в последнюю ячейку умной таблицы If .Cells(r1_, 1) <> "" Then r1_ = r1_ + 1 'если она заполнена, то будем работать с ячейкой ниже на 1 строку .Range("A" & r1_).Resize(1, n_) = ar 'вставляем наш массив в ячейки от "A" & r1_ и на n_ ячеек вправо End With 'конец работы с активным листом Application.DisplayAlerts = 0 'отключаем Excelю возможность писать сообщения ActiveWorkbook.Save 'сохраняем книгу Application.DisplayAlerts = 1 'включаем Excelю возможность писать сообщения ActiveWorkbook.Close 'закрываем книгу End Sub
[/vba]
Так нужно? [vba]
Код
Sub kopir() Dim d_ As Range 'd_ - диапазон ячеек Set d_ = Range("I12,I16,L16,I20,L20") 'каких ячеек n_ = d_.Count 'сколько их штук ReDim ar(1 To 1, 1 To n_) 'ar - массив в одну строку и n_ столбцов For i = 1 To n_ 'заполняем массив, цикл от 1 до n_ ar(1, i) = d_.Areas(i).Cells(1).Value 'i-й элемент массива по горизонтали равен 'первой ячейке каждого из поддиапазонов диапазона d_ Next i 'коней цикла Workbooks.Open Filename:=ThisWorkbook.Path & "\basa2.xlsx" 'открываем файл База, лежащий в той же папке, что и этот файл With ActiveSheet 'работаем с активным листом r1_ = .Cells(.Rows.Count, 1).End(3).Row 'от последней ячейки в столбце А прыгаем наверх '(как будто на листе из ячейки A1048576 нажали Контрл+СтрелкаВверх), попадаем в последнюю ячейку умной таблицы If .Cells(r1_, 1) <> "" Then r1_ = r1_ + 1 'если она заполнена, то будем работать с ячейкой ниже на 1 строку .Range("A" & r1_).Resize(1, n_) = ar 'вставляем наш массив в ячейки от "A" & r1_ и на n_ ячеек вправо End With 'конец работы с активным листом Application.DisplayAlerts = 0 'отключаем Excelю возможность писать сообщения ActiveWorkbook.Save 'сохраняем книгу Application.DisplayAlerts = 1 'включаем Excelю возможность писать сообщения ActiveWorkbook.Close 'закрываем книгу End Sub
_Boroda_, Да, спасибо, все работает. Некоторые моменты, по коду, даже с комментариями не понятны, не мое это, программирование , но в принципе разобрался. Еще вот такой вопрос, а как этот макрос ведет себя в сети, смогут ли с ним работать одновременно несколько человек?
_Boroda_, Да, спасибо, все работает. Некоторые моменты, по коду, даже с комментариями не понятны, не мое это, программирование , но в принципе разобрался. Еще вот такой вопрос, а как этот макрос ведет себя в сети, смогут ли с ним работать одновременно несколько человек?ASWP
я знаю что ничего не знаю, но другие не знают и этого
Совсем-совсем одновременно нет - файл База может быть открыт для сохранения только у кого-то одного. Но если как кролики по-быстрому открыл-вставил-закрыл, то можно. Можно еще сделать проверку на то, открыт ли файл. Поищите, тут на форуме были такие темы
Совсем-совсем одновременно нет - файл База может быть открыт для сохранения только у кого-то одного. Но если как кролики по-быстрому открыл-вставил-закрыл, то можно. Можно еще сделать проверку на то, открыт ли файл. Поищите, тут на форуме были такие темы_Boroda_
Вариантов много, но вот как их "прикрутить" к макросу не понятно. Вот нашел такой вариант, он вообще подходит?
[vba]
Код
Function FileIsOpenTest(TargetWorkbook As String) As Boolean Dim TestBook As Workbook On Error Resume Next Set TestBook = Workbooks(TargetWorkbook) If Err.Number = 0 Then FileIsOpenTest = True Else FileIsOpenTest = False End If End Function
Вариантов много, но вот как их "прикрутить" к макросу не понятно. Вот нашел такой вариант, он вообще подходит?
[vba]
Код
Function FileIsOpenTest(TargetWorkbook As String) As Boolean Dim TestBook As Workbook On Error Resume Next Set TestBook = Workbooks(TargetWorkbook) If Err.Number = 0 Then FileIsOpenTest = True Else FileIsOpenTest = False End If End Function
Во-первых, в этом коде не хватает важной строки: [vba]
Код
Function FileIsOpenTest(TargetWorkbook As String) As Boolean Dim TestBook As Workbook Err.Clear On Error Resume Next Set TestBook = Workbooks(TargetWorkbook) If Err.Number = 0 Then FileIsOpenTest = True Else FileIsOpenTest = False End If End Function
[/vba] Теперь засовываете этот код хоть в тот же модуль, хоть в новый и в начале макроса _Boroda_ прописываете [vba]
Код
If FileIsOpenTest("Здесь_Имя_Вашего_Файла.xlsm") Then MsgBox "Файл уже открыт!" Exit Sub End If
[/vba]
Во-первых, в этом коде не хватает важной строки: [vba]
Код
Function FileIsOpenTest(TargetWorkbook As String) As Boolean Dim TestBook As Workbook Err.Clear On Error Resume Next Set TestBook = Workbooks(TargetWorkbook) If Err.Number = 0 Then FileIsOpenTest = True Else FileIsOpenTest = False End If End Function
[/vba] Теперь засовываете этот код хоть в тот же модуль, хоть в новый и в начале макроса _Boroda_ прописываете [vba]
Код
If FileIsOpenTest("Здесь_Имя_Вашего_Файла.xlsm") Then MsgBox "Файл уже открыт!" Exit Sub End If
Это какой? Сброса ошибки? А зачем там нужен сброс ошибки?
Я бы написал примерно так: [vba]
Код
Sub kopir() Dim d_ As Range 'd_ - диапазон ячеек fn0_ = "basa2.xlsx" 'название файла On Error Resume Next 'пропуск возможной ошибки Set Otkr = Workbooks(fn0_) 'попытка обратиться к файлу fn0_ If Otkr <> Empty Then 'если обращение к файлу прошло успешно ff = MsgBox("Файл ''" & fn0_ & "'' открыт. Зайдите попозже.") 'пишем сообщение Exit Sub 'выходим из макроса End If 'конец ЕСЛИ On Error GoTo 0 'приведение сообщений об ошибках к обычному состоянию Set d_ = Range("I12:L12,I16,L16,I20,L20") ' каких ячеек !!!ИЗМЕНЕНО n_ = d_.Areas.Count 'сколько там диапазонов !!!ИЗМЕНЕНО ReDim ar(1 To 1, 1 To n_) 'ar - массив в одну строку и n_ столбцов For i = 1 To n_ 'заполняем массив, цикл от 1 до n_ ar(1, i) = d_.Areas(i).Cells(1).Value 'i-й элемент массива по горизонтали равен 'первой ячейке каждого из поддиапазонов диапазона d_ Next i 'коней цикла Application.ScreenUpdating = 0 'отключаем обновление экрана Workbooks.Open Filename:=ThisWorkbook.Path & "\" & fn0_ 'открываем файл База, лежащий в той же папке, что и этот файл With ActiveSheet 'работаем с активным листом r1_ = .Cells(.Rows.Count, 1).End(3).Row 'от последней ячейки в столбце А прыгаем наверх '(как будто на листе из ячейки A1048576 нажали Контрл+СтрелкаВверх), попадаем в последнюю ячейку умной таблицы If .Cells(r1_, 1) <> "" Then r1_ = r1_ + 1 'если она заполнена, то будем работать с ячейкой ниже на 1 строку .Range("A" & r1_).Resize(1, n_) = ar 'вставляем наш массив в ячейки от "A" & r1_ и на n_ ячеек вправо End With 'конец работы с активным листом Application.DisplayAlerts = 0 'отключаем Excelю возможность писать сообщения ActiveWorkbook.Save 'сохраняем книгу Application.DisplayAlerts = 1 'включаем Excelю возможность писать сообщения ActiveWorkbook.Close 'закрываем книгу d_.ClearContents 'очищаем диапазоны MsgBox "Запись данных произведена" 'сообщаем, что все хорошо Application.ScreenUpdating = 1 'включаем обновление экрана End Sub
Это какой? Сброса ошибки? А зачем там нужен сброс ошибки?
Я бы написал примерно так: [vba]
Код
Sub kopir() Dim d_ As Range 'd_ - диапазон ячеек fn0_ = "basa2.xlsx" 'название файла On Error Resume Next 'пропуск возможной ошибки Set Otkr = Workbooks(fn0_) 'попытка обратиться к файлу fn0_ If Otkr <> Empty Then 'если обращение к файлу прошло успешно ff = MsgBox("Файл ''" & fn0_ & "'' открыт. Зайдите попозже.") 'пишем сообщение Exit Sub 'выходим из макроса End If 'конец ЕСЛИ On Error GoTo 0 'приведение сообщений об ошибках к обычному состоянию Set d_ = Range("I12:L12,I16,L16,I20,L20") ' каких ячеек !!!ИЗМЕНЕНО n_ = d_.Areas.Count 'сколько там диапазонов !!!ИЗМЕНЕНО ReDim ar(1 To 1, 1 To n_) 'ar - массив в одну строку и n_ столбцов For i = 1 To n_ 'заполняем массив, цикл от 1 до n_ ar(1, i) = d_.Areas(i).Cells(1).Value 'i-й элемент массива по горизонтали равен 'первой ячейке каждого из поддиапазонов диапазона d_ Next i 'коней цикла Application.ScreenUpdating = 0 'отключаем обновление экрана Workbooks.Open Filename:=ThisWorkbook.Path & "\" & fn0_ 'открываем файл База, лежащий в той же папке, что и этот файл With ActiveSheet 'работаем с активным листом r1_ = .Cells(.Rows.Count, 1).End(3).Row 'от последней ячейки в столбце А прыгаем наверх '(как будто на листе из ячейки A1048576 нажали Контрл+СтрелкаВверх), попадаем в последнюю ячейку умной таблицы If .Cells(r1_, 1) <> "" Then r1_ = r1_ + 1 'если она заполнена, то будем работать с ячейкой ниже на 1 строку .Range("A" & r1_).Resize(1, n_) = ar 'вставляем наш массив в ячейки от "A" & r1_ и на n_ ячеек вправо End With 'конец работы с активным листом Application.DisplayAlerts = 0 'отключаем Excelю возможность писать сообщения ActiveWorkbook.Save 'сохраняем книгу Application.DisplayAlerts = 1 'включаем Excelю возможность писать сообщения ActiveWorkbook.Close 'закрываем книгу d_.ClearContents 'очищаем диапазоны MsgBox "Запись данных произведена" 'сообщаем, что все хорошо Application.ScreenUpdating = 1 'включаем обновление экрана End Sub
_Boroda_, Спасибо за еще один вариант. Только в примере база должна лежать рядом с файлом, немного переделал, открывает и на другом диске. А очистка диапазонов у меня тоже была, но я ее сделал по своему, как смог, а только сейчас понял, что у нас же диапазон был присвоен [vba]
_Boroda_, Спасибо за еще один вариант. Только в примере база должна лежать рядом с файлом, немного переделал, открывает и на другом диске. А очистка диапазонов у меня тоже была, но я ее сделал по своему, как смог, а только сейчас понял, что у нас же диапазон был присвоен [vba]
А можно сделать, чтобы функция проверки работала с файлом в локальной сети? Я нашел макрос,он работает, но не совсем корректно с вашей второй функцией, у меня проблема с циклом, я не могу его правильно начать и закончить. [vba]
Код
Function FileIsBusy(File$) As Boolean ' не открывая файла проверяет, открыт ли он вообще кем-либо Dim FN%: FN = FreeFile On Error Resume Next Open File For Random Access Write Lock Write As #FN Close #FN FileIsBusy = (Err <> 0) End Function
А можно сделать, чтобы функция проверки работала с файлом в локальной сети? Я нашел макрос,он работает, но не совсем корректно с вашей второй функцией, у меня проблема с циклом, я не могу его правильно начать и закончить. [vba]
Код
Function FileIsBusy(File$) As Boolean ' не открывая файла проверяет, открыт ли он вообще кем-либо Dim FN%: FN = FreeFile On Error Resume Next Open File For Random Access Write Lock Write As #FN Close #FN FileIsBusy = (Err <> 0) End Function
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
, но в принципе разобрался. 
