Hugo, Смотрю я на этот код. Да он прекрасно работает, но что-то добавить в него Номерация строк в Вашем коде копируется с листа ИТОГ - а желательно бы, чтоб она формировалась заново. Лист данные вы закинули в библиотеку, а данные этой библиотеки нигде не выгружали - да? Чесно говоря в Вашем коде я абсолютно ничего не понял, даже заполнить до конца лист Механический не смог - хоть застрелись.
Hugo, Смотрю я на этот код. Да он прекрасно работает, но что-то добавить в него Номерация строк в Вашем коде копируется с листа ИТОГ - а желательно бы, чтоб она формировалась заново. Лист данные вы закинули в библиотеку, а данные этой библиотеки нигде не выгружали - да? Чесно говоря в Вашем коде я абсолютно ничего не понял, даже заполнить до конца лист Механический не смог - хоть застрелись.ZamoK
Нумерацию без проблем можно сделать как угодно - просто заполняем b(i,1) значением i, а в элементы остальные копируем из a
[vba]
Код
b(i, 1) = i For x = 2 To 4: b(i, x) = a(el, x): Next
[/vba]
Лист данные я закинул в словарь, даже в два чтоб проще было. Выгружать всё кучей никуда ведь не требуется, из этого словаря берём данные когда они нужны "точечно". Что там непонятно не понимаю Алгоритм выше описал, и в коде есть комментарии. Схематично - сперва запоминаем какой номер куда нужно копировать, затем на какой лист какую строку нужно копировать, и уже затем копируем (через массивы для скорости).
Нумерацию без проблем можно сделать как угодно - просто заполняем b(i,1) значением i, а в элементы остальные копируем из a
[vba]
Код
b(i, 1) = i For x = 2 To 4: b(i, x) = a(el, x): Next
[/vba]
Лист данные я закинул в словарь, даже в два чтоб проще было. Выгружать всё кучей никуда ведь не требуется, из этого словаря берём данные когда они нужны "точечно". Что там непонятно не понимаю Алгоритм выше описал, и в коде есть комментарии. Схематично - сперва запоминаем какой номер куда нужно копировать, затем на какой лист какую строку нужно копировать, и уже затем копируем (через массивы для скорости).Hugo
В СЛОВАРЯХ есть только те данные, которые туда поместили, т.е. из листов Sheets("Данные") код брал данные из первого и из пятого столбцов, других данных из Sheets("Данные") в словарях нет. Если нужно сразу взять ещё что-то - то и берите, дописывайте код по аналогии. Но сперва нужно продумать что, зачем, куда, что потом с этим делать будете. Я пока пас, работа...
В СЛОВАРЯХ есть только те данные, которые туда поместили, т.е. из листов Sheets("Данные") код брал данные из первого и из пятого столбцов, других данных из Sheets("Данные") в словарях нет. Если нужно сразу взять ещё что-то - то и берите, дописывайте код по аналогии. Но сперва нужно продумать что, зачем, куда, что потом с этим делать будете. Я пока пас, работа...Hugo
Вот представьте: Школа - 4 класс - Немецкий (и у Вас по нему 3-) - текст на 2 листа - большой словарь. Вопрос: какова вероятность ? Вот примерно такая ситуация
Вот представьте: Школа - 4 класс - Немецкий (и у Вас по нему 3-) - текст на 2 листа - большой словарь. Вопрос: какова вероятность ? Вот примерно такая ситуация ZamoK
Ну уж что такое словарь все знают, кто в школе языки учил - есть слово, и есть его перевод. Перевод может быть как одно значение, так и набор/коллекция значений. Знаем слово - по нему в словаре узнаём перевод. Так и в scripting.dictionary - есть ключ, и к нему значение. В одном словаре это одно значение, в другом я сделал коллекцию значений. Это основное, остальное техника применения...
Ну уж что такое словарь все знают, кто в школе языки учил - есть слово, и есть его перевод. Перевод может быть как одно значение, так и набор/коллекция значений. Знаем слово - по нему в словаре узнаём перевод. Так и в scripting.dictionary - есть ключ, и к нему значение. В одном словаре это одно значение, в другом я сделал коллекцию значений. Это основное, остальное техника применения...Hugo
Hugo, а если нужно чтоб Крепёж попадал ещё и на лист Покупные, т.е. на два листа одно и тоже
[vba]
Код
a = Sheets("Данные").[a1].CurrentRegion.Columns(1).Resize(, 5).Value For i = 2 To UBound(a) t = Trim(a(i, 1)) If a(i, 5) > 0 Then d3.Item(t) = a(i, 5) 'норма расхода Select Case Trim(a(i, 3)) Case "Сборка": d1.Item(t) = "Сборка" Case "Покупные": d1.Item(t) = "Покупные" Case "Кооперация": d1.Item(t) = "Покупные" Case "Крепеж": d1.Item(t) = "Крепёж" Case Else: d1.Item(t) = "Механический" End Select Next
[/vba]
Hugo, а если нужно чтоб Крепёж попадал ещё и на лист Покупные, т.е. на два листа одно и тоже
[vba]
Код
a = Sheets("Данные").[a1].CurrentRegion.Columns(1).Resize(, 5).Value For i = 2 To UBound(a) t = Trim(a(i, 1)) If a(i, 5) > 0 Then d3.Item(t) = a(i, 5) 'норма расхода Select Case Trim(a(i, 3)) Case "Сборка": d1.Item(t) = "Сборка" Case "Покупные": d1.Item(t) = "Покупные" Case "Кооперация": d1.Item(t) = "Покупные" Case "Крепеж": d1.Item(t) = "Крепёж" Case Else: d1.Item(t) = "Механический" End Select Next
нужно чтоб Крепёж попадал ещё и на лист Покупные, т.е. на два листа одно и тоже
то это ломает всю логику кода. Тогда проще в конце кода (перед End Sub) взять весь крепёж и скопировать под покупные, затем пройтись и поменять порядковые номера. Заходим в крепёж, смотрим последнюю занятую строку - если больше 2х, то берём данные в массив. Далее аналогично идём в покупные, смотрим строку, по результату в массиве меняем порядковые номера (или не меняем) и выгружаем. Попробуйте реализовать, это не сложно.
нужно чтоб Крепёж попадал ещё и на лист Покупные, т.е. на два листа одно и тоже
то это ломает всю логику кода. Тогда проще в конце кода (перед End Sub) взять весь крепёж и скопировать под покупные, затем пройтись и поменять порядковые номера. Заходим в крепёж, смотрим последнюю занятую строку - если больше 2х, то берём данные в массив. Далее аналогично идём в покупные, смотрим строку, по результату в массиве меняем порядковые номера (или не меняем) и выгружаем. Попробуйте реализовать, это не сложно.Hugo
Hugo, я конечно понимаю что вы люди занятые и помочь нет времени, но вот что я с вашей Hugo, помощью сляпал
[vba]
Код
Option Explicit Sub tt() Dim a(), i&, d1 As Object, d2 As Object, d3 As Object, t$, k, kol As Object, el, x&
Set d1 = CreateObject("scripting.dictionary"): d1.comparemode = 1 Set d2 = CreateObject("scripting.dictionary"): d2.comparemode = 1 Set d3 = CreateObject("scripting.dictionary"): d3.comparemode = 1 'норма расхода
'1. набираем словарь номеров с именами листов по данным из "Данные" a = Sheets("Данные").[a1].CurrentRegion.Columns(1).Resize(, 5).Value For i = 2 To UBound(a) t = Trim(a(i, 1)) If a(i, 5) > 0 Then d3.Item(t) = a(i, 5) 'норма расхода Select Case Trim(a(i, 3)) Case "Крепёж": d1.Item(t) = "Покупные" End Select Next
'2. "Итог" берём в массив, проходим циклом, проверяем номер по словарю - получаем имя листа, 'который берём в другой словарь, где каждому имени листа собираем коллекцию номеров строк, которые в него будем копировать.
a = Sheets("Итог").[a2].CurrentRegion.Columns(1).Resize(, 4).Value For i = 2 To UBound(a) t = Trim(a(i, 2)) If d1.exists(t) Then If Not d2.exists(d1.Item(t)) Then d2.Add d1.Item(t), New Collection d2.Item(d1.Item(t)).Add i End If Next a = Sheets("Данные").[a1].CurrentRegion.Columns(1).Resize(, 5).Value For i = 2 To UBound(a) t = Trim(a(i, 1)) If a(i, 5) > 0 Then d3.Item(t) = a(i, 5) Select Case Trim(a(i, 3)) Case "Сборка": d1.Item(t) = "Сборка" Case "Крепёж": d1.Item(t) = "Крепёж" Case "Кооперация": d1.Item(t) = "Покупные" Case "Покупные": d1.Item(t) = "Покупные" Case Else: d1.Item(t) = "Механический" End Select Next a = Sheets("Итог").[a2].CurrentRegion.Columns(1).Resize(, 4).Value For i = 2 To UBound(a) t = Trim(a(i, 2)) If d1.exists(t) Then If Not d2.exists(d1.Item(t)) Then d2.Add d1.Item(t), New Collection d2.Item(d1.Item(t)).Add i End If Next '3. цикл уже по словарю имён листов - берём ключ, создаём массив нужного размера (всё уже известно), 'перекладываем в него данные из исходного массива, выгружаем на лист.
For Each k In d2.keys Set kol = d2.Item(k) ReDim B(1 To kol.Count, 1 To 4) As String i = 0 For Each el In kol i = i + 1 B(i, 1) = i For x = 2 To 4: B(i, x) = a(el, x): Next Next With Sheets(k) .UsedRange.Offset(2).Clear .[a3].Resize(UBound(B), 4) = B End With Next End Sub
[/vba]
конечно пришлось и верхнюю часть кода немного изменить и
не тут чуть раньше получилось надо было вставить, результат вроде правильный, а вот с частью грамматики написания, правильно хоть или у меня вообще что-то не то получилось?
Hugo, я конечно понимаю что вы люди занятые и помочь нет времени, но вот что я с вашей Hugo, помощью сляпал
[vba]
Код
Option Explicit Sub tt() Dim a(), i&, d1 As Object, d2 As Object, d3 As Object, t$, k, kol As Object, el, x&
Set d1 = CreateObject("scripting.dictionary"): d1.comparemode = 1 Set d2 = CreateObject("scripting.dictionary"): d2.comparemode = 1 Set d3 = CreateObject("scripting.dictionary"): d3.comparemode = 1 'норма расхода
'1. набираем словарь номеров с именами листов по данным из "Данные" a = Sheets("Данные").[a1].CurrentRegion.Columns(1).Resize(, 5).Value For i = 2 To UBound(a) t = Trim(a(i, 1)) If a(i, 5) > 0 Then d3.Item(t) = a(i, 5) 'норма расхода Select Case Trim(a(i, 3)) Case "Крепёж": d1.Item(t) = "Покупные" End Select Next
'2. "Итог" берём в массив, проходим циклом, проверяем номер по словарю - получаем имя листа, 'который берём в другой словарь, где каждому имени листа собираем коллекцию номеров строк, которые в него будем копировать.
a = Sheets("Итог").[a2].CurrentRegion.Columns(1).Resize(, 4).Value For i = 2 To UBound(a) t = Trim(a(i, 2)) If d1.exists(t) Then If Not d2.exists(d1.Item(t)) Then d2.Add d1.Item(t), New Collection d2.Item(d1.Item(t)).Add i End If Next a = Sheets("Данные").[a1].CurrentRegion.Columns(1).Resize(, 5).Value For i = 2 To UBound(a) t = Trim(a(i, 1)) If a(i, 5) > 0 Then d3.Item(t) = a(i, 5) Select Case Trim(a(i, 3)) Case "Сборка": d1.Item(t) = "Сборка" Case "Крепёж": d1.Item(t) = "Крепёж" Case "Кооперация": d1.Item(t) = "Покупные" Case "Покупные": d1.Item(t) = "Покупные" Case Else: d1.Item(t) = "Механический" End Select Next a = Sheets("Итог").[a2].CurrentRegion.Columns(1).Resize(, 4).Value For i = 2 To UBound(a) t = Trim(a(i, 2)) If d1.exists(t) Then If Not d2.exists(d1.Item(t)) Then d2.Add d1.Item(t), New Collection d2.Item(d1.Item(t)).Add i End If Next '3. цикл уже по словарю имён листов - берём ключ, создаём массив нужного размера (всё уже известно), 'перекладываем в него данные из исходного массива, выгружаем на лист.
For Each k In d2.keys Set kol = d2.Item(k) ReDim B(1 To kol.Count, 1 To 4) As String i = 0 For Each el In kol i = i + 1 B(i, 1) = i For x = 2 To 4: B(i, x) = a(el, x): Next Next With Sheets(k) .UsedRange.Offset(2).Clear .[a3].Resize(UBound(B), 4) = B End With Next End Sub
[/vba]
конечно пришлось и верхнюю часть кода немного изменить и
не тут чуть раньше получилось надо было вставить, результат вроде правильный, а вот с частью грамматики написания, правильно хоть или у меня вообще что-то не то получилось?ZamoK
Доброго дня, ZamoK. Получилось правильно, но так Вы выполняете много лишних действий - два лишних раза берёте данные в массив, два лишних раза их перебираете в цикле, и всё только чтоб в итоге докопировать данные из одного листа в другой. Если всего данных не много - это быстро, ну а если там поп полмиллиона на каждом листе будет? Ну и ещё по мелочи два раза делаете одно и тоже с третьм словарём, что лишнее в этом случае и в общем лишнее пока вообще, т.к. он не используется.
Я предлагаю просто дописать в конце моего варианта перед End Sub вот это: [vba]
Код
'Тогда проще в конце кода (перед End Sub) взять весь крепёж и скопировать под покупные... Dim il& 'дообъявить нужно... 'Заходим в крепёж, смотрим последнюю занятую строку - если больше 2х, то берём данные в массив. With Sheets("Крепёж") il = .Cells(.Rows.Count, 1).End(xlUp).Row If il > 2 Then 'значит есть что копировать a = Range(.[A3], .Range("D" & il)).Value
'Далее аналогично идём в покупные, смотрим строку, по результату в массиве меняем порядковые номера (или не меняем) и выгружаем. With Sheets("Покупные") il = .Cells(.Rows.Count, 1).End(xlUp).Row If il > 2 Then 'значит нужно менять номера, ибо копировать будем ниже For i = 1 To UBound(a): a(i, 1) = il - 2 + i: Next End If .Cells(il + 1, 1).Resize(UBound(a), 4) = a End With
End If End With
End Sub
[/vba]
Есть правда одна ерунда, которую парой слов кода не победить, и думаю это косяк офиса - изначально данные выгружаются из массива строкового типа (делал чтоб не искажало номера типа 753513.001), а затем копируются с листа на лист через массив variant - и измененённые порядковые номера форматируются на листе в любом случае как числа. Если напрягает - можно что-то придумать (что замедлит процесс)... Ну или используйте свой вариант. Можно пойти третьим путём - в первый словарь заносить перечень листов для каждого номера, строкой или тоже коллекцией - но это тоже замедлт процесс, да и код станет сложнее.
Доброго дня, ZamoK. Получилось правильно, но так Вы выполняете много лишних действий - два лишних раза берёте данные в массив, два лишних раза их перебираете в цикле, и всё только чтоб в итоге докопировать данные из одного листа в другой. Если всего данных не много - это быстро, ну а если там поп полмиллиона на каждом листе будет? Ну и ещё по мелочи два раза делаете одно и тоже с третьм словарём, что лишнее в этом случае и в общем лишнее пока вообще, т.к. он не используется.
Я предлагаю просто дописать в конце моего варианта перед End Sub вот это: [vba]
Код
'Тогда проще в конце кода (перед End Sub) взять весь крепёж и скопировать под покупные... Dim il& 'дообъявить нужно... 'Заходим в крепёж, смотрим последнюю занятую строку - если больше 2х, то берём данные в массив. With Sheets("Крепёж") il = .Cells(.Rows.Count, 1).End(xlUp).Row If il > 2 Then 'значит есть что копировать a = Range(.[A3], .Range("D" & il)).Value
'Далее аналогично идём в покупные, смотрим строку, по результату в массиве меняем порядковые номера (или не меняем) и выгружаем. With Sheets("Покупные") il = .Cells(.Rows.Count, 1).End(xlUp).Row If il > 2 Then 'значит нужно менять номера, ибо копировать будем ниже For i = 1 To UBound(a): a(i, 1) = il - 2 + i: Next End If .Cells(il + 1, 1).Resize(UBound(a), 4) = a End With
End If End With
End Sub
[/vba]
Есть правда одна ерунда, которую парой слов кода не победить, и думаю это косяк офиса - изначально данные выгружаются из массива строкового типа (делал чтоб не искажало номера типа 753513.001), а затем копируются с листа на лист через массив variant - и измененённые порядковые номера форматируются на листе в любом случае как числа. Если напрягает - можно что-то придумать (что замедлит процесс)... Ну или используйте свой вариант. Можно пойти третьим путём - в первый словарь заносить перечень листов для каждого номера, строкой или тоже коллекцией - но это тоже замедлт процесс, да и код станет сложнее.Hugo