Найти пересечение столбца и строки на других листах

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

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

Найти пересечение столбца и строки на других листах (Макросы/Sub)

Юля-ля

Дата: Четверг, 01.04.2021, 15:53 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

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

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

Есть первый лист со сводной информацией, количество строк может быть любым, столбцы всегда такие. Надо найти по связке Номера ЛД( строка) с Номером семестра (столбцы).

Нужно найти такую же сцепку Номер ЛД с Номером семестра(они все в одном столбце, только на разных строках) на других листах, только на других листах она расположена следующим образом:

когда находится строка с номером нужного ЛД и ячейка с нужным названием семестра нужно как-то взять эту ячейку с количеством и передать ее на первый лист. Проблема возникает в том, что номера семестров располагаются в одном столбце друг под другом( при этом не по порядку)
В файлах добавила исходный пример.

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

Сообщение отредактировал Юля-ля - Четверг, 01.04.2021, 15:54

Ответить

Kuzmich

Дата: Четверг, 01.04.2021, 18:24 | Сообщение № 2

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

Ранг: Ветеран

Сообщений: 713

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

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

Excel 2003

Цитата

Проблема возникает в том, что номера семестров располагаются в одном столбце

Попробуйте для начала код, который надо впоследствии доделать
[vba]

Код

'при активном листе Сводная
Sub iDolgSemestr()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim DolgSemestr As String
Dim FoundDolgSemestr As Range
Dim Group As String
Dim FoundLD As Range
Dim FoundLD_Row As Long
Dim j As Integer              'для цикла по семестрам в строке 1
Dim n As Integer
iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
  For i = 2 To iLastRow       'цикл по номерам ЛД на листе Сводная
    Group = Cells(i, "G")     'группа и соответствующее имя листа
    DolgSemestr = Range("H1") 'Кол-во долгов Первый семестр, потом  сделать цикл по j
    With Worksheets(Group)
      Set FoundDolgSemestr = .Columns("F").Find(DolgSemestr, , xlValues, xlWhole)
        n = FoundDolgSemestr.MergeArea.Count
      iLR = FoundDolgSemestr.Offset(n).End(xlDown).Row
        'ищем номер ЛД на листе группы в соответствующем семетру диапазоне
      Set FoundLD = .Range("E" & FoundDolgSemestr.Row + n & ":E" & iLR).Find(Cells(i, "B"), , xlValues, xlWhole)
      FoundLD_Row = FoundLD.Row     'нашли номер строки с ЛД на листе группы

    'берете в этой строке нужное значение и переносите на лист Сводная

    End With
  Next
End Sub

[/vba]

Ответить

NikitaDvorets

Дата: Четверг, 01.04.2021, 20:43 | Сообщение № 3

Группа: Авторы

Ранг: Ветеран

Сообщений: 611

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

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

Excel 2019

Добрый день.
Ничего не имею против варианта макроса.
Есть альтернативный вариант свода данных по долгам с помощью формул ИНДЕКС+ПОИСКПОЗ при условии внедрения дополнительного столбца с конкатенацией данных по ЛД и долгам по семестрам.

К сообщению приложен файл: ___01-04-2021.xlsm (70.8 Kb)

Сообщение отредактировал NikitaDvorets - Пятница, 02.04.2021, 12:13

Ответить

Юля-ля

Дата: Пятница, 02.04.2021, 15:22 | Сообщение № 4

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

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

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

NikitaDvorets, да я думала над этим, но количество листов может быть больше и в формуле я ссылки на названия этих листов не смогу прописать

Ответить

Юля-ля

Дата: Пятница, 02.04.2021, 16:03 | Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

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

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

Kuzmich, я не мастер программирования, попыталась заполнить столбец по первому семестру и до конца он не выполняется вылетает с ошибкой что нет такого айдишника в том диапазоне(это действительно так, переведенные студенты потом просто добавились), я сделала цикл с if , он отработал пару раз и опять та же ошибка. Может не туда его поместила?

Ответить

Kuzmich

Дата: Пятница, 02.04.2021, 16:14 | Сообщение № 6

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

Ранг: Ветеран

Сообщений: 713

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

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

Excel 2003

Цитата

вылетает с ошибкой что нет такого айдишника в том диапазоне(это действительно так, переведенные студенты потом просто добавились)

[vba]

Код

'при активном листе Сводная
Sub iDolgSemestr()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim DolgSemestr As String
Dim FoundDolgSemestr As Range
Dim Group As String
Dim FoundLD As Range
Dim FoundLD_Row As Long
Dim j As Integer              'для цикла по семестрам в строке 1
Dim n As Integer
Application.ScreenUpdating = False
iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
Range("H2:O" & iLastRow).ClearContents
For j = 8 To 15
   DolgSemestr = Cells(1, j)  'Кол-во долгов Первый семестр, потом  сделать цикл по j
  For i = 2 To iLastRow       'цикл по номерам ЛД на листе Сводная
    Group = Cells(i, "G")     'группа и соответствующее имя листа
    With Worksheets(Group)
      Set FoundDolgSemestr = .Columns("F").Find(DolgSemestr, , xlValues, xlWhole)
      If Not FoundDolgSemestr Is Nothing Then
          n = FoundDolgSemestr.MergeArea.Count              'кол-во объединенных ячеек
        iLR = FoundDolgSemestr.Offset(n).End(xlDown).Row    'последняя строка в диапазоне
        'ищем номер ЛД на листе группы в соответствующем семестру диапазоне
      Set FoundLD = .Range("E" & FoundDolgSemestr.Row + n & ":E" & iLR).Find(Cells(i, "B"), , xlValues, xlWhole)
        If Not FoundLD Is Nothing Then
          FoundLD_Row = FoundLD.Row     'нашли номер строки с ЛД на листе группы
          'берете в этой строке нужное значение и переносите на лист Сводная
          Cells(i, j) = .Cells(FoundLD_Row, "F")
        End If
      End If
    End With
  Next
Next
Application.ScreenUpdating = True
End Sub

[/vba]

Цитата

[vba]

Код

'при активном листе Сводная
Sub iDolgSemestr()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim DolgSemestr As String
Dim FoundDolgSemestr As Range
Dim Group As String
Dim FoundLD As Range
Dim FoundLD_Row As Long
Dim j As Integer              'для цикла по семестрам в строке 1
Dim n As Integer
Application.ScreenUpdating = False
iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
Range("H2:O" & iLastRow).ClearContents
For j = 8 To 15
   DolgSemestr = Cells(1, j)  'Кол-во долгов Первый семестр, потом  сделать цикл по j
  For i = 2 To iLastRow       'цикл по номерам ЛД на листе Сводная
    Group = Cells(i, "G")     'группа и соответствующее имя листа
    With Worksheets(Group)
      Set FoundDolgSemestr = .Columns("F").Find(DolgSemestr, , xlValues, xlWhole)
      If Not FoundDolgSemestr Is Nothing Then
          n = FoundDolgSemestr.MergeArea.Count              'кол-во объединенных ячеек
        iLR = FoundDolgSemestr.Offset(n).End(xlDown).Row    'последняя строка в диапазоне
        'ищем номер ЛД на листе группы в соответствующем семестру диапазоне
      Set FoundLD = .Range("E" & FoundDolgSemestr.Row + n & ":E" & iLR).Find(Cells(i, "B"), , xlValues, xlWhole)
        If Not FoundLD Is Nothing Then
          FoundLD_Row = FoundLD.Row     'нашли номер строки с ЛД на листе группы
          'берете в этой строке нужное значение и переносите на лист Сводная
          Cells(i, j) = .Cells(FoundLD_Row, "F")
        End If
      End If
    End With
  Next
Next
Application.ScreenUpdating = True
End Sub

[/vba]Kuzmich

Ответить

Сообщение

Цитата

[vba]

Код

'при активном листе Сводная
Sub iDolgSemestr()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim DolgSemestr As String
Dim FoundDolgSemestr As Range
Dim Group As String
Dim FoundLD As Range
Dim FoundLD_Row As Long
Dim j As Integer              'для цикла по семестрам в строке 1
Dim n As Integer
Application.ScreenUpdating = False
iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
Range("H2:O" & iLastRow).ClearContents
For j = 8 To 15
   DolgSemestr = Cells(1, j)  'Кол-во долгов Первый семестр, потом  сделать цикл по j
  For i = 2 To iLastRow       'цикл по номерам ЛД на листе Сводная
    Group = Cells(i, "G")     'группа и соответствующее имя листа
    With Worksheets(Group)
      Set FoundDolgSemestr = .Columns("F").Find(DolgSemestr, , xlValues, xlWhole)
      If Not FoundDolgSemestr Is Nothing Then
          n = FoundDolgSemestr.MergeArea.Count              'кол-во объединенных ячеек
        iLR = FoundDolgSemestr.Offset(n).End(xlDown).Row    'последняя строка в диапазоне
        'ищем номер ЛД на листе группы в соответствующем семестру диапазоне
      Set FoundLD = .Range("E" & FoundDolgSemestr.Row + n & ":E" & iLR).Find(Cells(i, "B"), , xlValues, xlWhole)
        If Not FoundLD Is Nothing Then
          FoundLD_Row = FoundLD.Row     'нашли номер строки с ЛД на листе группы
          'берете в этой строке нужное значение и переносите на лист Сводная
          Cells(i, j) = .Cells(FoundLD_Row, "F")
        End If
      End If
    End With
  Next
Next
Application.ScreenUpdating = True
End Sub

[/vba]

Автор - Kuzmich
Дата добавления - 02.04.2021 в 16:14

Найти пересечение столбца и строки на других листах (Макросы/Sub)

Страница 1 из 1
1