Поиск и вставка значений на листы по заданной дате

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск и вставка значений на листы по заданной дате (Макросы/Sub)

gge29

Дата: Вторник, 04.09.2018, 18:02 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 244

Репутация: 3 ±

Замечаний: 0% ±

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

К сообщению приложен файл: 5996397.xlsm (89.5 Kb)

Ответить

_Boroda_

Дата: Вторник, 04.09.2018, 22:03 | Сообщение № 2

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16674

Репутация: 6479 ±

Замечаний: 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