Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Создание одной таблицы из двух разных (присвоить изделиям этикетки)
 
#1
20.10.2020 21:37:30
Здравствуйте, помогите создать макрос для создания определенной таблицы, из имеющихся двух таблиц. Словами трудно объяснить, покажу рисунком, и прикреплю файл пример задачи с решением. Количество строк в листах "Отчет" и "Нормы" всегда разное, а количество столбцов не меняется. Но еще, чтоб значение в строку "Синтепон UA" из листа "Нормы" в будущую таблицу копировались из листа "Отчет" колонки "H".
 
 
 
#2
20.10.2020 22:05:00
Юрий Адамец, не понял для синтепона почему иначе все
Код
Sub dsd()
Dim sh As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim i As Long, lr As Long
Set sh = Worksheets("Отчет"): Set sh2 = Worksheets("Нормы"): Set sh3 = Worksheets("Готовые нормы")
sh3.Range("A2:F11111").Clear
For i = 2 To sh2.Cells(Rows.Count, 1).End(xlUp).Row
    lr = sh3.Cells(Rows.Count, 2).End(xlUp).Row + 1
    sh.Range("B2:C5").Copy Destination:=sh3.Cells(lr, 2)
    sh2.Range("A" & i & ":C" & i).Copy Destination:=sh3.Range(Cells(lr, 4), Cells(lr + 3, 6))
    If sh2.Range("A" & i) = "Синтепон UA" Then
    sh.Range("H2:H5").Copy Destination:=sh3.Range(Cells(lr, 5), Cells(lr + 3, 5))
    End If
Next i
sh3.Range("A2") = 1: sh3.Range("A3") = 2
sh3.Range("A2:A3").AutoFill Destination:=Range("A2:A" & sh3.Cells(Rows.Count, 2).End(xlUp).Row)
End Sub
Изменено: Mershik - 20.10.2020 22:09:13 (заменил файл и макрос)
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
21.10.2020 16:31:42
Спасибо, только на листе "Отчет", всегда разное количество строк (продукции), а этот макрос рапределяет нормы только для этих 4х.
Изменено: Юрий Адамец - 21.10.2020 16:32:39
 
 
 
#4
21.10.2020 16:36:03
Юрий Адамец, какой пример такой ответ)

вообще как то звучит неприятно:
Цитата
Спасибо, только
Код
Sub dsd()
Dim sh As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim i As Long, lr As Long
Set sh = Worksheets("Отчет"): Set sh2 = Worksheets("Нормы"): Set sh3 = Worksheets("Готовые нормы")
sh3.Range("A2:F11111").Clear
lr2 = sh.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To sh2.Cells(Rows.Count, 1).End(xlUp).Row
        For n = 2 To lr2
            lr = sh3.Cells(Rows.Count, 2).End(xlUp).Row + 1
            sh.Range("B" & n & ":C" & n).Copy Destination:=sh3.Cells(lr, 2)
            sh2.Range("A" & i & ":C" & i).Copy Destination:=sh3.Cells(lr, 4)
            If sh2.Range("A" & i) = "Синтепон UA" Then
            sh.Cells(n, 8).Copy Destination:=sh3.Cells(lr, 5)
            End If
        Next n
    Next i

sh3.Range("A2") = 1: sh3.Range("A3") = 2
sh3.Range("A2:A3").AutoFill Destination:=Range("A2:A" & sh3.Cells(Rows.Count, 2).End(xlUp).Row)
End Sub
Изменено: Mershik - 21.10.2020 17:01:12
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#5
21.10.2020 17:06:29
Благодарю, работает отменно!
 
 
 
Страницы: 1
Наверх