Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 22.03.2019, 15:52   #11
Елена195
Пользователь
 
Регистрация: 21.01.2019
Сообщений: 27
По умолчанию

Теперь все получилось, спасибо больше!
Елена195 вне форума Ответить с цитированием
Старый 24.05.2019, 18:05   #12
Елена195
Пользователь
 
Регистрация: 21.01.2019
Сообщений: 27
По умолчанию

Сергей, вы мне в прошлый раз очень помогли. Но к сожалению у меня возникла новая загвоздка.
В добавилась еще одна таблица S-Y, данные из которой нужно так же соотносить с данными из таблицы B-G.
Попыталась модифицировать макрос, и теперь не могу понять что они мне выдает, но вижу что не все.
Подскажите пожалуйста, как это можно исправить?

Файл во вложении

Код:
Sub Списочек()

    Sheets("C").Select
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    
    Dim iLastRow As Integer
    Dim iLastCol As Integer
    Dim i%, j%, r%, ColumnOffset%
    Set sh1 = Sheets("Сетка")
    Set sh2 = Sheets("C"): sh2.Range("a2:j50000").ClearContents
    ScreensOFF
    With sh1 ' работаем с первым листом
        iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        iLastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        r = 1 'сколько строк отступаем от первой
        ColumnOffset = .Range("L1").Column - .Range("C1").Column
        For j = .Range("C1").Column To .Range("G1").Column
           For i = 2 To iLastRow
                If .Cells(i, j + ColumnOffset) <> "" Then
                    r = r + 1
                    
                    sh2.Cells(r, "A") = .Cells(1, j)
                    sh2.Cells(r, "C") = .Cells(i, j)
                    sh2.Cells(r, "B") = .Cells(i, "B")
                    sh2.Cells(r, "d") = .Cells(i, j + ColumnOffset)
                   
                End If
            Next i
        Next j
      

    End With
    
  With sh1 ' работаем с первым листом
        iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        iLastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        r = 1 'сколько строк отступаем от первой
        ColumnOffset = .Range("u1").Column - .Range("C1").Column
        For j = .Range("C1").Column To .Range("G1").Column
           For i = 2 To iLastRow
                If .Cells(i, j + ColumnOffset) <> "" Then
                    r = r + 1
                    
                    sh2.Cells(r, "A") = .Cells(1, j)
                    sh2.Cells(r, "C") = .Cells(i, j)
                    sh2.Cells(r, "B") = .Cells(i, "B")
                    sh2.Cells(r, "d") = .Cells(i, j + ColumnOffset)
                   
                End If
            Next i
        Next j
      

    End With
 
    Set sh1 = Nothing
    Set sh2 = Nothing
      
  ScreensON
End Sub
Спасибо)
Вложения
Тип файла: xlsx пример.xlsm.xlsx (13.2 Кб, 5 просмотров)
Елена195 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сведение 2-х таблиц формулой Valat11 Microsoft Office Access 3 10.10.2018 14:28
сведение данных из разных таблиц в одну SingleSpart Microsoft Office Excel 2 04.08.2009 17:04
Сведение нескольких таблиц в одну Sega Microsoft Office Excel 3 05.08.2008 15:21
Сведение таблиц Funky_man Microsoft Office Excel 1 09.01.2008 07:20
Сведение таблиц Funky_man Microsoft Office Excel 1 08.01.2008 03:36