[VBA] Сведение двух таблиц макросом

[Елена195]

Добрый день!
Помогите пожалуйста разобраться с макросом:

У меня есть две таблицы. которые необходимо свести в список.
В список необходимо вывести дату, время,не пустой статус из второй таблицы и погоду из первой.

Пишу следующий макрос:

Option Explicit

Private Sub ScreensOFF()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual 
    Application.EnableCancelKey = xlDisabled ' Fix for Code execution has been interrupted
End Sub

Private Sub ScreensON()
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic 
End Sub
Sub Списочек()

    Sheets("C").Select
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    
    Dim iLastRow As Integer
    Dim iLastCol As Integer
    Dim i, j, y, r
    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 'сколько строк отступаем от первой
        For i = 2 To iLastRow 
            For j = .Range("c1").Column To .Range("g1000").Column 
           For y = .Range("l1").Column To .Range("p1000").Column
                If .Cells(i, y) <> "" 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, y)
                    
                    
                   
                End If
               Next
            Next j
        Next i
      

    End With
 
    Set sh1 = Nothing
    Set sh2 = Nothing
      
      
  ScreensON   
   
 
End Sub

Как видно на листе С статус присваивается всем дням, с 1 по 5, хотя сам статус стоит только 4 числа.

В примере сокращенный вариант файла.

Подскажите пожалуйста, в чем ошибка? Ведь я задала в условии выводить непустые значения из второй таблицы.

[Serge_Bliznykov]

Сообщение от Елена195

Подскажите пожалуйста, в чем ошибка? Ведь я задала в условии выводить непустые значения из второй таблицы.

ошибка в логике.
ведь этим циклом:

Сообщение от Елена195

For y = .Range("l1").Column To .Range("p1000").Column
                If .Cells(i, y) <> "" Then

вы находите в строке i не пустое значение и выводите его в результат.
так как Вы хотите в результате пустые ячейки увидеть?

да и вообще не понимаю, зачем цикл вкладывать в цикл.


так. стоп. может я не понимаю, что нужно получить в результате!
вот вы получаете:

Дата	Время	Погода	Статус
01.04.2019	6:20:00	Солнце	Не вышел
02.04.2019	6:20:00	Солнце	Не вышел
03.04.2019	6:20:00	Облака	Не вышел
04.04.2019	6:20:00	Солнце	Не вышел
05.04.2019	6:20:00	Облака	Не вышел
01.04.2019	10:20:00	Облака	Вышел
01.04.2019	10:20:00	Облака	Вышел
01.04.2019	10:20:00	Облака	Не вышел
01.04.2019	10:20:00	Облака	Вышел
02.04.2019	10:20:00	Облака	Вышел
02.04.2019	10:20:00	Облака	Вышел
02.04.2019	10:20:00	Облака	Не вышел
02.04.2019	10:20:00	Облака	Вышел
03.04.2019	10:20:00	Солнце	Вышел
03.04.2019	10:20:00	Солнце	Вышел
.....

а что хотели бы получить?

[Елена195]

Сообщение от Serge_Bliznykov

ошибка в логике.
ведь этим циклом:


вы находите в строке i не пустое значение и выводите его в результат.
так как Вы хотите в результате пустые ячейки увидеть?

да и вообще не понимаю, зачем цикл вкладывать в цикл.


так. стоп. может я не понимаю, что нужно получить в результате!
вот вы получаете:

а что хотели бы получить?

Сергей, я хочу получить ( на примере 1 и второго числа:

Дата Время Погода Статус
01.04.2019 10:20 Облака Вышел
01.04.2019 18:20 Солнце Вышел
01.04.2019 22:20 Облака Вышел
02.04.2019 10:20 Облака Вышел
02.04.2019 18:20 Дождь Не вышел
02.04.2019 22:20 Дождь Вышел

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

То есть цикл по сути нужен только по второй таблице, но тогда не понимаю как с помощью макроса свести статус и соответствующую погоду.

[Serge_Bliznykov]

так. я понял, что Вам надо!
Вас интересуют только те строчки, у которых по заданной дате статус не пустой.
т.е. у 1-го числа это три строки: 3, 7 и 9 (адресация Excel)

в первой и второй таблице столбцы всегда совпадают (и там и там даты подряд, без пропусков и повторов)?

[Елена195]

Сергей,

Да все верно.
Таблицы по дате всегда совпадают, без пробелов/пропусков/повторов.

Спасибо)

[Serge_Bliznykov]

попробуйте такой код:

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
 
    Set sh1 = Nothing
    Set sh2 = Nothing
      
  ScreensON
End Sub

[Елена195]

Сергей,

Большое спасибо, все суперски работает.

Подскажите пожалуйста, можно ли ColumnOffset переименовать в Y к примеру, или это название функции?

И что нам дает знак % в Dim i%?

Спасибо)

[Елена195]

Сергей, еще возник вопрос, можно ли как то добавить второй ColumnOffset , если нужно добавить данные еще из третьей таблицы?
Пытаюсь сделать так:

y = ColumnOffset1 = .Range("eg1").Column - .Range("Cz1").Column
        z = ColumnOffset2 = .Range("d1").Column - .Range("eg1").Column

Но пишет что переменная не уникальна, а если так:

      ColumnOffset(1) = .Range("eg1").Column - .Range("Cz1").Column
        ColumnOffset(2) = .Range("d1").Column - .Range("eg1").Column

То ошибка "duplicate declaration in current scope", перед этим в переменные заношу Y ,z в первом случае, либо ColumnOffset(1),ColumnOffset(2) во втором.

Эту переменную можно как то размножить?

[Serge_Bliznykov]

Сообщение от Елена195

Подскажите пожалуйста, можно ли ColumnOffset переименовать в Y к примеру, или это название функции?

да, конечно, это имя переменной, можно переименовать в любое, какое Вам нравится (и является допустимым наименованием переменной)

y - я не люблю однобуквенные имена. это допустимо для переменных цикла i,j
ну, ещё размерность N
ну массив A
а всё остальное лучше называть так, чтобы было понятно, что это за переменная и для чего она нужна.

например, iLastRow хранит номер последней строки.
ColumnOffset - хранит смещение для колонки (смещение от 1-таблицы до 2-й)
а что хранит y - не понятно.
Но это ваше дело - именуйте так, как Вам нравится

Сообщение от Елена195

И что нам дает знак % в Dim i%?

когда Вы пишете

Dim i, j, y, r

Вы объявляете переменные типа Variant (туда можно сохранить что угодно)

Лучше объявлять переменные именно того типа, с каким планируется их использовать
Например, в данном случае это целочисленный тип

Dim i As Integer, j As Integer, y As Integer, r As Integer

или сокращённо

Dim i%, j%, r%

% это сокращённое наименование для типа Integer:
см. https://docs.microsoft.com/ru-ru/dot...ype-characters

[Serge_Bliznykov]

Сообщение от Елена195

Сергей, еще возник вопрос, можно ли как то добавить второй ColumnOffset , если нужно добавить данные еще из третьей таблицы?

Так?

y = .Range("eg1").Column - .Range("Cz1").Column
z = .Range("d1").Column - .Range("eg1").Column