Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Записи участника (krosav4ig) - Мир MS Excel

Результаты поиска
krosav4ig Дата: Суббота, 21.09.2019, 23:31 | Сообщение № 2161 | Тема: построение прямой на графике (вариант)
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Gold_Barsik, если стоит Microsoft Office Compatibility Pack, попробуйте сохранить в xlsb (в поле тип файла обычно 5 строчка снизу)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеGold_Barsik, если стоит Microsoft Office Compatibility Pack, попробуйте сохранить в xlsb (в поле тип файла обычно 5 строчка снизу)

Автор - krosav4ig
Дата добавления - 21.09.2019 в 23:31
krosav4ig Дата: Среда, 25.09.2019, 02:17 | Сообщение № 2162 | Тема: Как посчитать в массиве суммы и поставить не на каждой строк
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Код
=ЕСЛИ(СУММ(СЧЁТЕСЛИ(H3;{"*Ардели*0,5*";"*Георгиевс*0,5*"}));;СУММ(СУММЕСЛИМН(I$3:I$23;C$3:C$23;C3;E$3:E$23;E3;H$3:H$23;{"*Ардели*0,5*";"*Георгиевс*0,5*"})))


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
Код
=ЕСЛИ(СУММ(СЧЁТЕСЛИ(H3;{"*Ардели*0,5*";"*Георгиевс*0,5*"}));;СУММ(СУММЕСЛИМН(I$3:I$23;C$3:C$23;C3;E$3:E$23;E3;H$3:H$23;{"*Ардели*0,5*";"*Георгиевс*0,5*"})))

Автор - krosav4ig
Дата добавления - 25.09.2019 в 02:17
krosav4ig Дата: Пятница, 27.09.2019, 22:32 | Сообщение № 2163 | Тема: Пронумеровать условные группы последовательности чисел
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
можно еще немного проще
Код
=МАКС(B1;1)+(A2<A1)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеможно еще немного проще
Код
=МАКС(B1;1)+(A2<A1)

Автор - krosav4ig
Дата добавления - 27.09.2019 в 22:32
krosav4ig Дата: Воскресенье, 29.09.2019, 15:46 | Сообщение № 2164 | Тема: Числа отображаются текстом, как исправить
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
[vba]
Код
Option Explicit
    
Private Sub CommandButton1_Click()
    Call sheetform
    Unload Me
End Sub
    
Sub test(ByRef arrtest#())  'Заполняем массив случайными числами из текстбокса
    ReDim arrtest(1 To Val(Tb1.Text), 1 To 2)
    
    For i = 1 To UBound(arrtest, 1)
        j = 1
        arrtest(i, j) = i ' номер итерации
        arrtest(i, j + 1) = Round(Tb1.Value * 99 * Rnd, 2) ' случайное число полученное умножением числа введенного в текстбоксе на генератор
    Next i
End Sub
    
' Выводим данные массива arrtest на новый лист после нажатия кнопки exit
    
Sub sheetform()
    Application.ScreenUpdating = False
    
    'Создаем новый лист с помощью объектной переменной (в этом случае новый лист создается строго перед активным листом и нигде больше)
    
    Dim SheetTest As Worksheet
    Dim Celltest As Range
    Dim currow As Integer ' переменная для счетчика строк
    Dim arrtest#() 'массива случайных чисел
    currow = 1
    
    Set SheetTest = Worksheets.Add
    SheetTest.Name = "test" & Sheets.Count
    Windows.Item(SheetTest.Parent.Name).DisplayGridlines = False ' убираем сетку
        
    'вставляем названия ячеек на созданный лист
    ' Заголовки столбцов
    SheetTest.Cells(currow, 1) = "№ Периода"
    SheetTest.Cells(currow, 2) = "Тестовое случайное значение"
    
    test arrtest ' вызываем процедуру заполнения массива arrtest случайными числами
    
    ' Заполняем лист данными из массива arrtest, куда мы предварительно внесли все расчетные значения ,ячейки таблицы
    With SheetTest.Cells(currow + 1, 1).Resize(UBound(arrtest, 1), UBound(arrtest, 2))
        .Columns(2).NumberFormat = "#,##0.00"
        .Value = arrtest
    End With
End Sub
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение[vba]
Код
Option Explicit
    
Private Sub CommandButton1_Click()
    Call sheetform
    Unload Me
End Sub
    
Sub test(ByRef arrtest#())  'Заполняем массив случайными числами из текстбокса
    ReDim arrtest(1 To Val(Tb1.Text), 1 To 2)
    
    For i = 1 To UBound(arrtest, 1)
        j = 1
        arrtest(i, j) = i ' номер итерации
        arrtest(i, j + 1) = Round(Tb1.Value * 99 * Rnd, 2) ' случайное число полученное умножением числа введенного в текстбоксе на генератор
    Next i
End Sub
    
' Выводим данные массива arrtest на новый лист после нажатия кнопки exit
    
Sub sheetform()
    Application.ScreenUpdating = False
    
    'Создаем новый лист с помощью объектной переменной (в этом случае новый лист создается строго перед активным листом и нигде больше)
    
    Dim SheetTest As Worksheet
    Dim Celltest As Range
    Dim currow As Integer ' переменная для счетчика строк
    Dim arrtest#() 'массива случайных чисел
    currow = 1
    
    Set SheetTest = Worksheets.Add
    SheetTest.Name = "test" & Sheets.Count
    Windows.Item(SheetTest.Parent.Name).DisplayGridlines = False ' убираем сетку
        
    'вставляем названия ячеек на созданный лист
    ' Заголовки столбцов
    SheetTest.Cells(currow, 1) = "№ Периода"
    SheetTest.Cells(currow, 2) = "Тестовое случайное значение"
    
    test arrtest ' вызываем процедуру заполнения массива arrtest случайными числами
    
    ' Заполняем лист данными из массива arrtest, куда мы предварительно внесли все расчетные значения ,ячейки таблицы
    With SheetTest.Cells(currow + 1, 1).Resize(UBound(arrtest, 1), UBound(arrtest, 2))
        .Columns(2).NumberFormat = "#,##0.00"
        .Value = arrtest
    End With
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 29.09.2019 в 15:46
krosav4ig Дата: Воскресенье, 29.09.2019, 16:32 | Сообщение № 2165 | Тема: Подсчет уникальных значений по нескольким критериям
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
UDF [vba]
Код
Function UsedRng() As Range
    Set UsedRng = Application.Caller.Parent.UsedRange
End Function
[/vba]в диспетчере имен создаем именованный диапазон ВсеСтроки
Код
=UsedRng()
в ячейке формула
Код
=СУММ(ЧАСТОТА(ЕСЛИ((ВсеСтроки I:I=I2)*(ВсеСтроки A:A<>"")*(ВсеСтроки D:D>=КОНМЕСЯЦА(СЕГОДНЯ();-1)+1)*(ВсеСтроки K:K=K2);ПОИСКПОЗ(ВсеСтроки A:A;A:A;0));СТРОКА(ВсеСтроки)-СТРОКА(K2)+1))


или использовать умные таблицы (Лист2)
Код
=СУММ(ЧАСТОТА(ЕСЛИ((Таблица1[Client]=Таблица1[@Client])*(Таблица1[AGR]<>"")*(Таблица1[Дата поступления]>=КОНМЕСЯЦА(СЕГОДНЯ();-1)+1)*(ВсеСтроки Таблица1[результат]=K2);ПОИСКПОЗ(Таблица1[AGR];Таблица1[AGR];0));СТРОКА(Таблица1)-СТРОКА(K2)+1))
К сообщению приложен файл: 6036041.xlsm (23.0 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеUDF [vba]
Код
Function UsedRng() As Range
    Set UsedRng = Application.Caller.Parent.UsedRange
End Function
[/vba]в диспетчере имен создаем именованный диапазон ВсеСтроки
Код
=UsedRng()
в ячейке формула
Код
=СУММ(ЧАСТОТА(ЕСЛИ((ВсеСтроки I:I=I2)*(ВсеСтроки A:A<>"")*(ВсеСтроки D:D>=КОНМЕСЯЦА(СЕГОДНЯ();-1)+1)*(ВсеСтроки K:K=K2);ПОИСКПОЗ(ВсеСтроки A:A;A:A;0));СТРОКА(ВсеСтроки)-СТРОКА(K2)+1))


или использовать умные таблицы (Лист2)
Код
=СУММ(ЧАСТОТА(ЕСЛИ((Таблица1[Client]=Таблица1[@Client])*(Таблица1[AGR]<>"")*(Таблица1[Дата поступления]>=КОНМЕСЯЦА(СЕГОДНЯ();-1)+1)*(ВсеСтроки Таблица1[результат]=K2);ПОИСКПОЗ(Таблица1[AGR];Таблица1[AGR];0));СТРОКА(Таблица1)-СТРОКА(K2)+1))

Автор - krosav4ig
Дата добавления - 29.09.2019 в 16:32
krosav4ig Дата: Понедельник, 30.09.2019, 17:20 | Сообщение № 2166 | Тема: Как в шаблоне изменить имя?
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеДобрый день
Слияние данных MS Excel и MS Word

Автор - krosav4ig
Дата добавления - 30.09.2019 в 17:20
krosav4ig Дата: Понедельник, 30.09.2019, 17:51 | Сообщение № 2167 | Тема: Подсчет уникальных значений по нескольким критериям
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
заменил UDF
[vba]
Код
Function UsedRng(Optional ByRef r As Range) As Range
    Set UsedRng = IIf(r Is Nothing, Application.Caller, r).Parent.UsedRange
End Function
[/vba]
Определение имени ВсеСтроки заменил на
Код
=UsedRng(Лист1!$A$1)


Ошибка была из-за того, что функция UsedRng возвращала использованный диапазон листа, на котором находится ячейка, из которой эта функция вызывается, т.е. ВсеСтроки - диапазон с Лист2, а столбцы с Лист1, а пробел между диапазонами в формуле - оператор пересечения.
К сообщению приложен файл: 8932097.xlsm (20.1 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Понедельник, 30.09.2019, 17:52
 
Ответить
Сообщениезаменил UDF
[vba]
Код
Function UsedRng(Optional ByRef r As Range) As Range
    Set UsedRng = IIf(r Is Nothing, Application.Caller, r).Parent.UsedRange
End Function
[/vba]
Определение имени ВсеСтроки заменил на
Код
=UsedRng(Лист1!$A$1)


Ошибка была из-за того, что функция UsedRng возвращала использованный диапазон листа, на котором находится ячейка, из которой эта функция вызывается, т.е. ВсеСтроки - диапазон с Лист2, а столбцы с Лист1, а пробел между диапазонами в формуле - оператор пересечения.

Автор - krosav4ig
Дата добавления - 30.09.2019 в 17:51
krosav4ig Дата: Вторник, 01.10.2019, 13:25 | Сообщение № 2168 | Тема: Настройка переодического сохранения/экспорта файла в Excel
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Добрый день
Функция отправки Xlsx тут
функция для создания триггера
[vba]
Код
function createTimeDrivenTrigger() {
    // Trigger every day at 09:00.
    ScriptApp.newTrigger('send_report_email')
        .timeBased()
        .everyDays(1)
        .atHour(9)
        .create();
}
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеДобрый день
Функция отправки Xlsx тут
функция для создания триггера
[vba]
Код
function createTimeDrivenTrigger() {
    // Trigger every day at 09:00.
    ScriptApp.newTrigger('send_report_email')
        .timeBased()
        .everyDays(1)
        .atHour(9)
        .create();
}
[/vba]

Автор - krosav4ig
Дата добавления - 01.10.2019 в 13:25
krosav4ig Дата: Среда, 02.10.2019, 22:04 | Сообщение № 2169 | Тема: Как в word вытащить таблицу из файла xls в разрезе компании
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Файлы для примера приложила.

Неа. Проверьте размер файлов, должен быть до 100кб.


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
Файлы для примера приложила.

Неа. Проверьте размер файлов, должен быть до 100кб.

Автор - krosav4ig
Дата добавления - 02.10.2019 в 22:04
krosav4ig Дата: Четверг, 03.10.2019, 05:08 | Сообщение № 2170 | Тема: выбор значений по критериям
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте
Можно

Можно
Как проще сделать

Тут читайте


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте
Можно

Можно
Как проще сделать

Тут читайте

Автор - krosav4ig
Дата добавления - 03.10.2019 в 05:08
krosav4ig Дата: Четверг, 03.10.2019, 05:35 | Сообщение № 2171 | Тема: Удаление символов внутри текста
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте
выделить B2 Данные>Мгновенное заполнение
или использовать формулу
Код
=ЗАМЕНИТЬ(ЛЕВБ(A2;ПОИСК("+";ПОДСТАВИТЬ(A2;"-";"+";{8}))-1);ПОИСК("+";ПОДСТАВИТЬ(A2;"-";"+";{5}));СУММ(ПОИСК("+";ПОДСТАВИТЬ(A2;"-";"+";{5;6}))*{-1;1});)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 03.10.2019, 07:32
 
Ответить
СообщениеЗдравствуйте
выделить B2 Данные>Мгновенное заполнение
или использовать формулу
Код
=ЗАМЕНИТЬ(ЛЕВБ(A2;ПОИСК("+";ПОДСТАВИТЬ(A2;"-";"+";{8}))-1);ПОИСК("+";ПОДСТАВИТЬ(A2;"-";"+";{5}));СУММ(ПОИСК("+";ПОДСТАВИТЬ(A2;"-";"+";{5;6}))*{-1;1});)

Автор - krosav4ig
Дата добавления - 03.10.2019 в 05:35
krosav4ig Дата: Пятница, 04.10.2019, 13:41 | Сообщение № 2172 | Тема: Изменение цвета шрифта
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте
Через Заменить я так понял нельзя этого сделать.

Не праввильно поняли
жмем F5 -> Alt+З -> если видим кнопку Больше>> жмем Alt+Ш
жмем Alt+И -> Delete -> Alt+ЯФ -> Ш -> выбираем шрифт -> Enter
жмем Alt+Ь -> Delete -> Alt+ЯФ -> Ш -> выбираем цвет шрифта -> Tab -> Enter
Заменить все


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте
Через Заменить я так понял нельзя этого сделать.

Не праввильно поняли
жмем F5 -> Alt+З -> если видим кнопку Больше>> жмем Alt+Ш
жмем Alt+И -> Delete -> Alt+ЯФ -> Ш -> выбираем шрифт -> Enter
жмем Alt+Ь -> Delete -> Alt+ЯФ -> Ш -> выбираем цвет шрифта -> Tab -> Enter
Заменить все

Автор - krosav4ig
Дата добавления - 04.10.2019 в 13:41
krosav4ig Дата: Воскресенье, 06.10.2019, 22:07 | Сообщение № 2173 | Тема: Перестали отправляться сообщения
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Добрый вечер.
В течение последних 2 часов не отправляются сообщения на форумы, вываливается на главную ucoz.ru


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Воскресенье, 06.10.2019, 22:09
 
Ответить
СообщениеДобрый вечер.
В течение последних 2 часов не отправляются сообщения на форумы, вываливается на главную ucoz.ru

Автор - krosav4ig
Дата добавления - 06.10.2019 в 22:07
krosav4ig Дата: Воскресенье, 06.10.2019, 22:07 | Сообщение № 2174 | Тема: Перестали отправляться сообщения
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Сюда добавилось, в Вопросы по Excel - фигвам


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Воскресенье, 06.10.2019, 22:09
 
Ответить
СообщениеСюда добавилось, в Вопросы по Excel - фигвам

Автор - krosav4ig
Дата добавления - 06.10.2019 в 22:07
krosav4ig Дата: Воскресенье, 06.10.2019, 23:27 | Сообщение № 2175 | Тема: Поиск совпадающей последовательности ячеек
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
у меня 131 без = и дальше не двигается


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеу меня 131 без = и дальше не двигается

Автор - krosav4ig
Дата добавления - 06.10.2019 в 23:27
krosav4ig Дата: Воскресенье, 06.10.2019, 23:31 | Сообщение № 2176 | Тема: Перестали отправляться сообщения
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
оказалось, что глючиит в одной теме http://www.excelworld.ru/forum/2-43095-1.
Сейчас в МШ отписался, там все норм


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеоказалось, что глючиит в одной теме http://www.excelworld.ru/forum/2-43095-1.
Сейчас в МШ отписался, там все норм

Автор - krosav4ig
Дата добавления - 06.10.2019 в 23:31
krosav4ig Дата: Понедельник, 07.10.2019, 02:37 | Сообщение № 2177 | Тема: поиск времени разных форматов (Excel 2003)
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте.
Код
=ЕСЛИ(И(--ТЕКСТ(A8;"ч:м:с")>=--ПСТР(D3;1;5);--ТЕКСТ(A8;"ч:м:с")<=--ПСТР(D3;7;5));B8;"")
Код
=ЕСЛИ(ИЛИ((--ТЕКСТ(A14;"ч:м:с")>=--ПСТР(P14:P23;1;5))*(--ТЕКСТ(A14;"ч:м:с")<=--ПСТР(P14:P23;7;5)));B14;"")


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте.
Код
=ЕСЛИ(И(--ТЕКСТ(A8;"ч:м:с")>=--ПСТР(D3;1;5);--ТЕКСТ(A8;"ч:м:с")<=--ПСТР(D3;7;5));B8;"")
Код
=ЕСЛИ(ИЛИ((--ТЕКСТ(A14;"ч:м:с")>=--ПСТР(P14:P23;1;5))*(--ТЕКСТ(A14;"ч:м:с")<=--ПСТР(P14:P23;7;5)));B14;"")

Автор - krosav4ig
Дата добавления - 07.10.2019 в 02:37
krosav4ig Дата: Вторник, 08.10.2019, 02:59 | Сообщение № 2178 | Тема: Поиск совпадающей последовательности ячеек
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
мои 131 симолов, по сути, то же самое, что и у bmv98rus
Код
=ПОИСКПОЗ(B5;МУМНОЖ(--(Т(СМЕЩ(A$1;СТРОКА(A$4:A$1000)+СТОЛБЕЦ(СМЕЩ(A1;;;;B5));))=ТРАНСП(СМЕЩ(A$5;;;B5)));СТРОКА(СМЕЩ(A1;;;B5))^0);)+5


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениемои 131 симолов, по сути, то же самое, что и у bmv98rus
Код
=ПОИСКПОЗ(B5;МУМНОЖ(--(Т(СМЕЩ(A$1;СТРОКА(A$4:A$1000)+СТОЛБЕЦ(СМЕЩ(A1;;;;B5));))=ТРАНСП(СМЕЩ(A$5;;;B5)));СТРОКА(СМЕЩ(A1;;;B5))^0);)+5

Автор - krosav4ig
Дата добавления - 08.10.2019 в 02:59
krosav4ig Дата: Пятница, 11.10.2019, 19:00 | Сообщение № 2179 | Тема: Как перенести выбранные значения из listbox в таблицу?
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
[vba]
Код
Private Sub CommandButton1_Click()
    Dim iPR As Long
    iPR = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Cells(iPR, 2) = txt_¹
    Cells(iPR, 3) = txt_fio
    Cells(iPR, 4) = txt_email
    Cells(iPR, 5) = txt_tel
    With txt_kvalif
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                s = s & "," & .List(i)
            End If
        Next
    End With
    Cells(iPR, 6) = Mid(s, 2)
    Cells(iPR, 7) = txt_stat
    Cells(iPR, 8) = txt_cok
    Cells(iPR, 9) = txt_raspor
    Unload UserForm1
    ThisWorkbook.Save
End Sub

Private Sub CommandButton2_Click() 'êîä äëÿ "Ñîõðàíèòü îòðåäàêòèðîâàííûé äàííûå"
    'If Edit_Copy = "Edit" Then
    Cells(ActiveCell.Row, 2) = txt_¹
    Cells(ActiveCell.Row, 3) = txt_fio
    Cells(ActiveCell.Row, 4) = txt_email
    Cells(ActiveCell.Row, 5) = txt_tel
    With txt_kvalif
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                s = s & "," & .List(i)
                    
            End If
        Next
    End With
    Cells(ActiveCell.Row, 6) = Mid(s, 2)
    Cells(ActiveCell.Row, 7) = txt_stat
    Cells(ActiveCell.Row, 8) = txt_cok
    Cells(ActiveCell.Row, 9) = txt_raspor
                
End Sub
[/vba]

[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    UserForm1.txt_¹ = CStr(Cells(Selection.Rows.Row, 2).Value)
    UserForm1.txt_fio = CStr(Cells(Selection.Rows.Row, 3).Value)
    UserForm1.txt_email = CStr(Cells(Selection.Rows.Row, 4).Value)
    UserForm1.txt_tel = CStr(Cells(Selection.Rows.Row, 5).Value)
    Dim arr, i
    arr = Split(CStr(Cells(Selection.Rows.Row, 6).Value), ",")
    If IsArray(arr) Then
        With UserForm1.txt_kvalif
            For i = 0 To .ListCount - 1
                If UBound(Filter(arr, .List(i), , vbTextCompare)) > -1 Then
                    .Selected(i) = True
                End If
            Next
        End With
    End If
    UserForm1.txt_stat = CStr(Cells(Selection.Rows.Row, 7).Value)
    UserForm1.txt_cok = CStr(Cells(Selection.Rows.Row, 8).Value)
    UserForm1.txt_raspor = CStr(Cells(Selection.Rows.Row, 9).Value)
    UserForm1.Show vbModeless
End Sub
[/vba]
К сообщению приложен файл: 1481309.xlsm (31.3 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение[vba]
Код
Private Sub CommandButton1_Click()
    Dim iPR As Long
    iPR = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Cells(iPR, 2) = txt_¹
    Cells(iPR, 3) = txt_fio
    Cells(iPR, 4) = txt_email
    Cells(iPR, 5) = txt_tel
    With txt_kvalif
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                s = s & "," & .List(i)
            End If
        Next
    End With
    Cells(iPR, 6) = Mid(s, 2)
    Cells(iPR, 7) = txt_stat
    Cells(iPR, 8) = txt_cok
    Cells(iPR, 9) = txt_raspor
    Unload UserForm1
    ThisWorkbook.Save
End Sub

Private Sub CommandButton2_Click() 'êîä äëÿ "Ñîõðàíèòü îòðåäàêòèðîâàííûé äàííûå"
    'If Edit_Copy = "Edit" Then
    Cells(ActiveCell.Row, 2) = txt_¹
    Cells(ActiveCell.Row, 3) = txt_fio
    Cells(ActiveCell.Row, 4) = txt_email
    Cells(ActiveCell.Row, 5) = txt_tel
    With txt_kvalif
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                s = s & "," & .List(i)
                    
            End If
        Next
    End With
    Cells(ActiveCell.Row, 6) = Mid(s, 2)
    Cells(ActiveCell.Row, 7) = txt_stat
    Cells(ActiveCell.Row, 8) = txt_cok
    Cells(ActiveCell.Row, 9) = txt_raspor
                
End Sub
[/vba]

[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    UserForm1.txt_¹ = CStr(Cells(Selection.Rows.Row, 2).Value)
    UserForm1.txt_fio = CStr(Cells(Selection.Rows.Row, 3).Value)
    UserForm1.txt_email = CStr(Cells(Selection.Rows.Row, 4).Value)
    UserForm1.txt_tel = CStr(Cells(Selection.Rows.Row, 5).Value)
    Dim arr, i
    arr = Split(CStr(Cells(Selection.Rows.Row, 6).Value), ",")
    If IsArray(arr) Then
        With UserForm1.txt_kvalif
            For i = 0 To .ListCount - 1
                If UBound(Filter(arr, .List(i), , vbTextCompare)) > -1 Then
                    .Selected(i) = True
                End If
            Next
        End With
    End If
    UserForm1.txt_stat = CStr(Cells(Selection.Rows.Row, 7).Value)
    UserForm1.txt_cok = CStr(Cells(Selection.Rows.Row, 8).Value)
    UserForm1.txt_raspor = CStr(Cells(Selection.Rows.Row, 9).Value)
    UserForm1.Show vbModeless
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 11.10.2019 в 19:00
krosav4ig Дата: Воскресенье, 27.10.2019, 23:41 | Сообщение № 2180 | Тема: Сохранение книги с определенным именем
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте
Format function
Workbook.SaveAs method
Workbook.SaveCopyAs method

Автор - krosav4ig
Дата добавления - 27.10.2019 в 23:41
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!