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

Вход

Регистрация

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

 

= Мир MS Excel/при выборе ФИО и месяца данные берутся с одноименного листа - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » при выборе ФИО и месяца данные берутся с одноименного листа (Макросы/Sub)
при выборе ФИО и месяца данные берутся с одноименного листа
ane4ka87 Дата: Пятница, 27.05.2022, 09:07 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

Всем доброго утра! и с пятницей!!! не могу решить задачу...нужно, чтобы при выборе ФИО и выборе месяца, данные брались с одноименного листа (лист=месяцу).
Заранее всех благодарю.
К сообщению приложен файл: 7003614.xlsm(26.4 Kb)
 
Ответить
СообщениеВсем доброго утра! и с пятницей!!! не могу решить задачу...нужно, чтобы при выборе ФИО и выборе месяца, данные брались с одноименного листа (лист=месяцу).
Заранее всех благодарю.

Автор - ane4ka87
Дата добавления - 27.05.2022 в 09:07
jun Дата: Пятница, 27.05.2022, 09:21 | Сообщение № 2
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 15 ±
Замечаний: 0% ±

ane4ka87, добрый день!
можно, например так:
[vba]
Код
Sub GetData()
Dim wsh As Worksheet, FIO As String, month_criteria As String
Dim arr, data As Range, lr As Long, lc As Long
With Worksheets("расчет")
    month_criteria = .Range("B4").Value
    FIO = .Range("C1").Value
    With Worksheets(month_criteria)
        Set data = Worksheets(month_criteria).Cells.Find(FIO)
        lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
        arr = .Range(.Cells(data.Row, 2), .Cells(data.Row, lc))
    End With
    .Range("B5").Resize(UBound(arr, 2), 1) = Application.Transpose(arr)
End With
End Sub
[/vba]
Нажимаете кнопку на листе Расчет и данные подтягиваются (макрос привязан к кнопке, находится в стандартном модуле)
К сообщению приложен файл: 4555044.xlsm(29.9 Kb)
 
Ответить
Сообщениеane4ka87, добрый день!
можно, например так:
[vba]
Код
Sub GetData()
Dim wsh As Worksheet, FIO As String, month_criteria As String
Dim arr, data As Range, lr As Long, lc As Long
With Worksheets("расчет")
    month_criteria = .Range("B4").Value
    FIO = .Range("C1").Value
    With Worksheets(month_criteria)
        Set data = Worksheets(month_criteria).Cells.Find(FIO)
        lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
        arr = .Range(.Cells(data.Row, 2), .Cells(data.Row, lc))
    End With
    .Range("B5").Resize(UBound(arr, 2), 1) = Application.Transpose(arr)
End With
End Sub
[/vba]
Нажимаете кнопку на листе Расчет и данные подтягиваются (макрос привязан к кнопке, находится в стандартном модуле)

Автор - jun
Дата добавления - 27.05.2022 в 09:21
ane4ka87 Дата: Пятница, 27.05.2022, 09:27 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

jun, спасибо! Попробовала, но не работает. :(
Выбираю ФИО, месяц, но данные не меняются.
 
Ответить
Сообщениеjun, спасибо! Попробовала, но не работает. :(
Выбираю ФИО, месяц, но данные не меняются.

Автор - ane4ka87
Дата добавления - 27.05.2022 в 09:27
jun Дата: Пятница, 27.05.2022, 09:59 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 15 ±
Замечаний: 0% ±

Вы кнопку нажимали после выбора?
 
Ответить
СообщениеВы кнопку нажимали после выбора?

Автор - jun
Дата добавления - 27.05.2022 в 09:59
ane4ka87 Дата: Пятница, 27.05.2022, 10:42 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

jun, нет. А что за кнопка? %)
 
Ответить
Сообщениеjun, нет. А что за кнопка? %)

Автор - ane4ka87
Дата добавления - 27.05.2022 в 10:42
jun Дата: Пятница, 27.05.2022, 11:05 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 15 ±
Замечаний: 0% ±

см вложение:
К сообщению приложен файл: 7090165.png(37.2 Kb)
 
Ответить
Сообщениесм вложение:

Автор - jun
Дата добавления - 27.05.2022 в 11:05
jun Дата: Пятница, 27.05.2022, 11:29 | Сообщение № 7
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 15 ±
Замечаний: 0% ±

ane4ka87, либо такой вариант макроса в модуле листа "расчет":
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim idData As Range, criteria_month As String
    Set idData = Intersect(Target, Range("C1"))
    If Not idData Is Nothing Then
        criteria_month = Worksheets("расчет").Range("B4").Value
        Set shData = Worksheets(criteria_month)
            If idData <> "" Then
                With shData
                    r = .Columns(1).Find(idData, , xlValues, xlWhole).Row
                    c = .Rows(1).Find("Проект", , xlValues, xlWhole).Column
                    Range("B5").Resize(3) = WorksheetFunction.Transpose(.Cells(r, 2).Resize(, 3))
                End With
            End If
    End If
End Sub
[/vba]
К сообщению приложен файл: 7003614-1-.xlsm(26.5 Kb)
 
Ответить
Сообщениеane4ka87, либо такой вариант макроса в модуле листа "расчет":
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim idData As Range, criteria_month As String
    Set idData = Intersect(Target, Range("C1"))
    If Not idData Is Nothing Then
        criteria_month = Worksheets("расчет").Range("B4").Value
        Set shData = Worksheets(criteria_month)
            If idData <> "" Then
                With shData
                    r = .Columns(1).Find(idData, , xlValues, xlWhole).Row
                    c = .Rows(1).Find("Проект", , xlValues, xlWhole).Column
                    Range("B5").Resize(3) = WorksheetFunction.Transpose(.Cells(r, 2).Resize(, 3))
                End With
            End If
    End If
End Sub
[/vba]

Автор - jun
Дата добавления - 27.05.2022 в 11:29
msi2102 Дата: Пятница, 27.05.2022, 15:20 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 134
Репутация: 65 ±
Замечаний: 0% ±

Excel 2007
В принципе можете это сделать без макроса, формулой:
Код
=ВПР($C$1;ДВССЫЛ($B$4&"!A2:D100");2;0)
К сообщению приложен файл: 2457737.xlsm(26.2 Kb)


Сообщение отредактировал msi2102 - Пятница, 27.05.2022, 15:21
 
Ответить
СообщениеВ принципе можете это сделать без макроса, формулой:
Код
=ВПР($C$1;ДВССЫЛ($B$4&"!A2:D100");2;0)

Автор - msi2102
Дата добавления - 27.05.2022 в 15:20
ane4ka87 Дата: Пятница, 27.05.2022, 16:14 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

jun, работает! Но не совсем корректно. Нужно сперва выбрать ФИО сотрудника, данные на этом этапе не должны появляться, если месяц не выбран. Далее данные подтягиваются в зависимости от выбранного месяца.
 
Ответить
Сообщениеjun, работает! Но не совсем корректно. Нужно сперва выбрать ФИО сотрудника, данные на этом этапе не должны появляться, если месяц не выбран. Далее данные подтягиваются в зависимости от выбранного месяца.

Автор - ane4ka87
Дата добавления - 27.05.2022 в 16:14
jun Дата: Пятница, 27.05.2022, 16:42 | Сообщение № 10
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 15 ±
Замечаний: 0% ±

ane4ka87, подправил, см. файл
К сообщению приложен файл: 1246027.xlsm(26.8 Kb)
 
Ответить
Сообщениеane4ka87, подправил, см. файл

Автор - jun
Дата добавления - 27.05.2022 в 16:42
ane4ka87 Дата: Пятница, 27.05.2022, 20:15 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

jun, благодарю! все работает hands
 
Ответить
Сообщениеjun, благодарю! все работает hands

Автор - ane4ka87
Дата добавления - 27.05.2022 в 20:15
ane4ka87 Дата: Пятница, 27.05.2022, 20:16 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

msi2102, спасибо -)
 
Ответить
Сообщениеmsi2102, спасибо -)

Автор - ane4ka87
Дата добавления - 27.05.2022 в 20:16
ane4ka87 Дата: Пятница, 27.05.2022, 20:34 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

jun, а не подскажите, еще ка добавить сообщение, если листа не существует.
заранее благодарю!
 
Ответить
Сообщениеjun, а не подскажите, еще ка добавить сообщение, если листа не существует.
заранее благодарю!

Автор - ane4ka87
Дата добавления - 27.05.2022 в 20:34
Kuzmich Дата: Пятница, 27.05.2022, 22:10 | Сообщение № 14
Группа: Проверенные
Ранг: Ветеран
Сообщений: 661
Репутация: 148 ±
Замечаний: 0% ±

Excel 2003
Цитата
добавить сообщение, если листа не существует

Добавить строки в макрос
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim idData As Range, FIO As String
    Set idData = Intersect(Target, Range("B4")): FIO = Range("C1").Value
    If Not idData Is Nothing Then
        If SheetExist(Range("B4")) Then
          Set shData = Worksheets(idData.Value)
            If idData <> "" Then
                With shData
                    r = .Columns(1).Find(FIO, , xlValues, xlWhole).Row
                    c = .Rows(1).Find("Проект", , xlValues, xlWhole).Column
                    Range("B5").Resize(3) = WorksheetFunction.Transpose(.Cells(r, 2).Resize(, 3))
                End With
            End If
        Else
          MsgBox "В книге нет листа с именем: " & Range("B4")
        End If
    End If
End Sub
[/vba]
В стандартный модуль макрос
[vba]
Код
Function SheetExist(iName As String) As Boolean
    On Error Resume Next
    With Worksheets(iName): End With
    SheetExist = (Err = 0)
End Function
[/vba]
 
Ответить
Сообщение
Цитата
добавить сообщение, если листа не существует

Добавить строки в макрос
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim idData As Range, FIO As String
    Set idData = Intersect(Target, Range("B4")): FIO = Range("C1").Value
    If Not idData Is Nothing Then
        If SheetExist(Range("B4")) Then
          Set shData = Worksheets(idData.Value)
            If idData <> "" Then
                With shData
                    r = .Columns(1).Find(FIO, , xlValues, xlWhole).Row
                    c = .Rows(1).Find("Проект", , xlValues, xlWhole).Column
                    Range("B5").Resize(3) = WorksheetFunction.Transpose(.Cells(r, 2).Resize(, 3))
                End With
            End If
        Else
          MsgBox "В книге нет листа с именем: " & Range("B4")
        End If
    End If
End Sub
[/vba]
В стандартный модуль макрос
[vba]
Код
Function SheetExist(iName As String) As Boolean
    On Error Resume Next
    With Worksheets(iName): End With
    SheetExist = (Err = 0)
End Function
[/vba]

Автор - Kuzmich
Дата добавления - 27.05.2022 в 22:10
ane4ka87 Дата: Пятница, 27.05.2022, 22:27 | Сообщение № 15
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

Kuzmich, вы- просто бог VBA!!!! hands
Огромнейшее спасибо.
 
Ответить
СообщениеKuzmich, вы- просто бог VBA!!!! hands
Огромнейшее спасибо.

Автор - ane4ka87
Дата добавления - 27.05.2022 в 22:27
ane4ka87 Дата: Пятница, 27.05.2022, 23:53 | Сообщение № 16
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

Kuzmich, подскажите, пожалуйста, я часть информации беру с другого листа, без привязки к месяцу. И хочу чтобы она отображалась уже при выборе только фамилии. На данный момент у меня работает, только если я выбираю месяц ,то все поля во всех таблицах заполняются.
К сообщению приложен файл: 1895219.xlsm(32.1 Kb)


Сообщение отредактировал ane4ka87 - Суббота, 28.05.2022, 00:09
 
Ответить
СообщениеKuzmich, подскажите, пожалуйста, я часть информации беру с другого листа, без привязки к месяцу. И хочу чтобы она отображалась уже при выборе только фамилии. На данный момент у меня работает, только если я выбираю месяц ,то все поля во всех таблицах заполняются.

Автор - ane4ka87
Дата добавления - 27.05.2022 в 23:53
jun Дата: Суббота, 28.05.2022, 09:10 | Сообщение № 17
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 15 ±
Замечаний: 0% ±

ane4ka87, см.файл
К сообщению приложен файл: 8224625.xlsm(30.9 Kb)
 
Ответить
Сообщениеane4ka87, см.файл

Автор - jun
Дата добавления - 28.05.2022 в 09:10
ane4ka87 Дата: Суббота, 28.05.2022, 12:11 | Сообщение № 18
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

jun, добрый день! ) теперь другая часть перестала работать.(
При выборе ФИО сотрудника стали появляться его персональные данные, а вот сведения по командировке не работают, не изменяются при выборе месяца.
 
Ответить
Сообщениеjun, добрый день! ) теперь другая часть перестала работать.(
При выборе ФИО сотрудника стали появляться его персональные данные, а вот сведения по командировке не работают, не изменяются при выборе месяца.

Автор - ane4ka87
Дата добавления - 28.05.2022 в 12:11
jun Дата: Суббота, 28.05.2022, 20:01 | Сообщение № 19
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 15 ±
Замечаний: 0% ±

ane4ka87, добрый вечер! Прошу прощения за долгий ответ - был не у компьютера.
Подправил файл.
К сообщению приложен файл: 4259463.xlsm(31.7 Kb)
 
Ответить
Сообщениеane4ka87, добрый вечер! Прошу прощения за долгий ответ - был не у компьютера.
Подправил файл.

Автор - jun
Дата добавления - 28.05.2022 в 20:01
ane4ka87 Дата: Воскресенье, 29.05.2022, 21:49 | Сообщение № 20
Группа: Пользователи
Ранг: Новичок
Сообщений: 17
Репутация: 0 ±
Замечаний: 0% ±

jun, спасибо Вам огромное! Все супер! hands
 
Ответить
Сообщениеjun, спасибо Вам огромное! Все супер! hands

Автор - ane4ka87
Дата добавления - 29.05.2022 в 21:49
Мир MS Excel » Вопросы и решения » Вопросы по VBA » при выборе ФИО и месяца данные берутся с одноименного листа (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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