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

Вход

Регистрация

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

 

= Мир MS Excel/Поиск и вставка значений на листы по заданной дате - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск и вставка значений на листы по заданной дате (Макросы/Sub)
Поиск и вставка значений на листы по заданной дате
gge29 Дата: Вторник, 04.09.2018, 18:02 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 212
Репутация: 3 ±
Замечаний: 0% ±

Добрый вечер!!!Помогите пожалуйста доработать интересную задумку.Форма почти готова(сделал для примера 2 листа,а так их 20)
Суть проблемы состоит в том,чтобы по заданной дате вставлять заполненные значения с формы на листы,наверное без применения ВПР не обойтись
Файл пример прилагается.
К сообщению приложен файл: 5996397.xlsm(89.5 Kb)
 
Ответить
СообщениеДобрый вечер!!!Помогите пожалуйста доработать интересную задумку.Форма почти готова(сделал для примера 2 листа,а так их 20)
Суть проблемы состоит в том,чтобы по заданной дате вставлять заполненные значения с формы на листы,наверное без применения ВПР не обойтись
Файл пример прилагается.

Автор - gge29
Дата добавления - 04.09.2018 в 18:02
_Boroda_ Дата: Вторник, 04.09.2018, 22:03 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 12984
Репутация: 5337 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Для любого количества листов
Условие такое - параллельные Label и TextBox должны называться с одинаковыми числовыми индексами (Label и TextBox1, Label2 и TextBox2, Label3 и TextBox3,...) и больше Label и TextBox с числовыми индексами на форме быть не должно (по крайней мере с индексами, меньшими количества листов в книге минус 1). И да, например, Label_1 - это НЕ числовой индекс
И доделал там у Вас ввод из календаря

[vba]
Код
Private Sub CommandButton1_Click()
    On Error Resume Next
    shn_ = ThisWorkbook.Sheets.Count - 1
    If IsDate(TextBoxDate.Value) Then
        ad_ = Sheets(Replace(Label1.Caption, "Лист ", "")).Cells.Find(What:=CDate(TextBoxDate.Value)).Address
        ReDim ar(1 To shn_, 1 To 2)
        For Each dd In SPR.Controls
            dcc = dd.Name
            If IsNumeric(Replace(dd.Name, "Label", "")) Then
                lb_ = lb_ + 1
                ar(lb_, 1) = Replace(dd.Caption, "Лист ", "")
            End If
            If IsNumeric(Replace(dd.Name, "TextBox", "")) Then
                tb_ = tb_ + 1
                ar(tb_, 2) = dd.Value
            End If
        Next dd
        For i = 1 To shn_
            Sheets(ar(i, 1)).Range(ad_).Offset(, 1) = ar(i, 2)
        Next i
    End If
End Sub
[/vba]
К сообщению приложен файл: 5996397_1.xlsm(82.1 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеДля любого количества листов
Условие такое - параллельные Label и TextBox должны называться с одинаковыми числовыми индексами (Label и TextBox1, Label2 и TextBox2, Label3 и TextBox3,...) и больше Label и TextBox с числовыми индексами на форме быть не должно (по крайней мере с индексами, меньшими количества листов в книге минус 1). И да, например, Label_1 - это НЕ числовой индекс
И доделал там у Вас ввод из календаря

[vba]
Код
Private Sub CommandButton1_Click()
    On Error Resume Next
    shn_ = ThisWorkbook.Sheets.Count - 1
    If IsDate(TextBoxDate.Value) Then
        ad_ = Sheets(Replace(Label1.Caption, "Лист ", "")).Cells.Find(What:=CDate(TextBoxDate.Value)).Address
        ReDim ar(1 To shn_, 1 To 2)
        For Each dd In SPR.Controls
            dcc = dd.Name
            If IsNumeric(Replace(dd.Name, "Label", "")) Then
                lb_ = lb_ + 1
                ar(lb_, 1) = Replace(dd.Caption, "Лист ", "")
            End If
            If IsNumeric(Replace(dd.Name, "TextBox", "")) Then
                tb_ = tb_ + 1
                ar(tb_, 2) = dd.Value
            End If
        Next dd
        For i = 1 To shn_
            Sheets(ar(i, 1)).Range(ad_).Offset(, 1) = ar(i, 2)
        Next i
    End If
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 04.09.2018 в 22:03
gge29 Дата: Вторник, 04.09.2018, 22:34 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 212
Репутация: 3 ±
Замечаний: 0% ±

Александр,не работает(((
При вводе даты формат например 05.09.2018 выходит 9/5/2018 и данные не вставляет в ячейки
 
Ответить
СообщениеАлександр,не работает(((
При вводе даты формат например 05.09.2018 выходит 9/5/2018 и данные не вставляет в ячейки

Автор - gge29
Дата добавления - 04.09.2018 в 22:34
_Boroda_ Дата: Вторник, 04.09.2018, 22:50 | Сообщение № 4
Группа: Модераторы
Ранг: Местный житель
Сообщений: 12984
Репутация: 5337 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
У Вас снова что-то с настройками разделителей. Неужели Вы думаете, что я положил бы сюда код, не проверив его у себя на компе?


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеУ Вас снова что-то с настройками разделителей. Неужели Вы думаете, что я положил бы сюда код, не проверив его у себя на компе?

Автор - _Boroda_
Дата добавления - 04.09.2018 в 22:50
gge29 Дата: Среда, 05.09.2018, 07:43 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 212
Репутация: 3 ±
Замечаний: 0% ±

Александр,я дико извиняюсь,при запуске одной NOVELовской программы она автоматом меняет разделитель с "," на "."
 
Ответить
СообщениеАлександр,я дико извиняюсь,при запуске одной NOVELовской программы она автоматом меняет разделитель с "," на "."

Автор - gge29
Дата добавления - 05.09.2018 в 07:43
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск и вставка значений на листы по заданной дате (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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