Различная выборка из диапазона столбца нескольких значений разного множества листов и копирование в сводные таблицы

@evsmm · Регистрация: 09.01.2019

Author24 — интернет-сервис помощи студентам

Вечер добрый. Чуть мало помню из студенческого курса написания алгоритмов выполнения повторяющихся задач. Просьба помогите, пожалуйста, автоматизировать процесс.
Суть такова имеется несколько листов 1..N но с одинаковыми значениями в столбцах A, B, D. При внесении различных значений в столбцы С, листов 1..N происходит формирования названия продукта 1..N. Иногда продукт состоит из похожих частей продукта. В итоге после формирования всех листов 1..N, необходимо свести в различные сводные таблицы лист з, лист к1 и лист к1(2). по разным критериям.

@Burk · 13.01.2019, 15:59

evsmm, если у вас не хватает знаний чтобы хотя начать делать, то обратитесь в раздел Фриланс этого форума, но перед этим дайте прочитать написанное вами своему приятелю, который малость разбирается в ВБА. Если он поймет ваши объяснения без доппояснений, то кто-то из вас шибко умный, а я ниже плинтуса.

@evsmm · 13.01.2019, 17:45 **[ТС]**

Вот покопавшийся на форуме нашел код, пытаюсь по подобию перебить не получается ошибку выдает в
mass() = ws.Range("À12

" & ws.Range("A12").CurrentRegion.Rows.Count + 4).Value

Подскажите в каком направлении двигаться, пожалуйста.

@Burk · 13.01.2019, 18:58

evsmm, вы никогда на форуме не найдете именно того, что вам нужно. Надо программировать самому, подглядывая в работающие макросы других авторов. Можно копировать какие-то куски. А здесь вы стали жертвой опечатки В строке с ошибкой в А12 стоит русское А перебейте. Правда не понять зачем там нужно + 4, если надо скопировать внутреннюю часть таблицы. Я бы написал так

Visual Basic

1	mass() = ws.Range("A12:D" & ws.Сells(Rows.Count,1).End(xlUp).Row).Value

@evsmm · 13.01.2019, 20:23 **[ТС]**

Тем и занимаюсь, беру раб.проект и смотрю как он работает и как его можно применить в своем проекте.
Спасибо вам за советы.

Будьте так добры подскажите где можно посмотреть как сложить два одинаковых значения которые повторяются, т.е. я так понимаю данный массив копирует сперва значения в указанном диапазоне на листе 1, а потом на листе 1(2) и вставляет значения по порядку.

@Hugo121 · 13.01.2019, 21:40

Самое простое - собирать всё в словарь. Ну или в словаре хранить индекс, а по нему в массиве (ну или в данном случае проще сразу на листе) суммировать.

@evsmm · 13.01.2019, 21:46 **[ТС]**

я так понимаю лучше по формуле:

=СУММ('1'!C12+'1 (2)'!C12) и т.д. по всем листам

и не мучатся писать массивы, выборки, а сделать все через ссылки на страницы)))

@Hugo121 · 13.01.2019, 21:50

Вот Ваш вариант, но на словаре (только добавил словарь). Попытайтесь понять - ещё не раз пригодится.

Visual Basic

Option Explicit
Private Sub Worksheet_Activate()
 
    Dim wsr As Worksheet, ws As Worksheet, mass(), i As Long, j As Long, t$, x&
 
    Application.ScreenUpdating = False
    Set wsr = Sheets("з")
    wsr.Range("A5:E" & wsr.Range("A5").CurrentRegion.Rows.Count).Clear
    j = 4
 
    With CreateObject("Scripting.Dictionary")
        .comparemode = 1
        For Each ws In ActiveWorkbook.Worksheets
            If Not (ws Is wsr) Then
                mass() = ws.Range("A12:C" & ws.Range("A12").CurrentRegion.Rows.Count + 1).Value
                For i = 1 To UBound(mass, 1)
                    If Not IsEmpty(mass(i, 3)) And IsNumeric(mass(i, 3)) Then
                        t = mass(i, 1) & "|" & mass(i, 2)
                        If Not .exists(t) Then
                            j = j + 1
                            .Item(t) = j
                            wsr.Range("A" & j).Value = mass(i, 1)
                            wsr.Range("B" & j).Value = mass(i, 2)
                            wsr.Range("C" & j).Value = mass(i, 3)
                        Else
                            x = .Item(t)
                            wsr.Range("C" & x).Value = wsr.Range("C" & x).Value + mass(i, 3)
                        End If
                    End If
                Next i
            End If
        Next
    End With
 
    Application.ScreenUpdating = True
End Sub

Добавлено через 2 минуты
Если статичны все наименования товаров и листов - то можно и формулами конечно.

@evsmm · 13.01.2019, 21:53 **[ТС]**

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

@evsmm · 14.01.2019, 14:14 **[ТС]**

Люди добрые подскажите вот эту часть кода (из примера сверху)

Visual Basic

1
2
3

Set wsr = Sheets("з")
    wsr.Range("A5:E" & wsr.Range("A5").CurrentRegion.Rows.Count).Clear
    j = 4

это обращение к диапазону с ячейки А5 по столбец Е + (&) ячейка А5 выбрать область.очистить ---?

Чуть не пойму: когда записываются данные на Sheets("з") и в последующем изменяются какие либо данные в других листах не стираются данные в Sheets("з"). Помогите разобраться.

@Hugo121 · 14.01.2019, 15:07

wsr.Range("A5").CurrentRegion.Rows.Count - это то, что тут написано: количество строк неразрывного диапазона ячейки А5.
Это число подставляется в адрес очищаемого диапазона "A5:E..".
Причём это количество строк считается не от А5, а от первой строки этого диапазона!
Если что-то не очищается - смотрите какое число подставляете.
И я тут ничего не менял, и не смотрел на счёт косяков.

P.S. А вообще можно (судя по примеру) не заморачиваться подсчётом, а тупо очищать всё

@evsmm · 14.01.2019, 17:12 **[ТС]**

Спасибо огромное за ответ.

Я макрорекордером записал чтоб очистить диапазон вот так:

в замен: wsr.Range("A5:E" & wsr.Range("A5").CurrentRegion.Rows.Count).Clear

Вот это:

Visual Basic

    Sheets("з").Select
    Range("A5:C493").Select
    Selection.ClearContents
    Range("A5").Select ' думаю что это лишнее

Нормально получилось)))

а может записать попробовать так:

Visual Basic

1 2	Sheets("з").Select Range("A5:C493").ClearContents ' не пробывал))

Вопрос на счет массива: я так понимаю массив считает все листы(1; 1(2)) ws и помещает результат в wsr (з). А как можно обойти лист wsr (з) и не считать его и записать в другой лист (к). Это необходимо прописать в переменных это лист (к)?

Сразу извиняюсь новичок в VBA.

Добавлено через 15 минут
Вопрос отпадает сделаю через ссылки на лист (з) и вопрос решён)))

@evsmm · 16.01.2019, 11:04 **[ТС]**

Люди добрые помогите. В данном коде копируются со всех листов диапазон A12 по D и суммируются с записью на лист "Заявка" искомого значения.

Visual Basic

Option Explicit
Private Sub Worksheet_Activate()
 
    Dim wsr As Worksheet, ws As Worksheet, mass(), i As Long, j As Long, t$, x&
 
    Application.ScreenUpdating = False
    Set wsr = Sheets("Заявка")
    ' Range("A5:E8").Select
    Sheets("Заявка").Select
    Range("A5:C493").Select
    Selection.ClearContents
    Range("A5").Select
    ' wsr.Range("A5:E" & wsr.Range("A5").CurrentRegion.Rows.Count).Clear
    j = 4
 
    With CreateObject("Scripting.Dictionary")
        .comparemode = 1
        For Each ws In ActiveWorkbook.Worksheets
            If Not (ws Is wsr) Then
                mass() = ws.Range("A12:C" & ws.Range("A12").CurrentRegion.Rows.Count + 1).Value
                For i = 1 To UBound(mass, 1)
                    If Not IsEmpty(mass(i, 3)) And IsNumeric(mass(i, 3)) Then
                        t = mass(i, 1) & "|" & mass(i, 2)
                        If Not .exists(t) Then
                            j = j + 1
                            .Item(t) = j
                            wsr.Range("A" & j).Value = mass(i, 1)
                            wsr.Range("B" & j).Value = mass(i, 2)
                            wsr.Range("C" & j).Value = mass(i, 3)
                                
                           Else
                            x = .Item(t)
                            wsr.Range("C" & x).Value = wsr.Range("C" & x).Value + mass(i, 3)
                          
                        End If
                    End If
                Next i
            End If
        Next
    End With
 
    Application.ScreenUpdating = True
End Sub

Как исправить код чтоб со всех листов копировался диапазон столбца A, столбца B и столбца H. начиная с 12 строки и дальше вниз. И вставлялся в итоговый лист "Заявка" в столбцы A, B, C начиная с 5 строки.

Заранее благодарю

Добавлено через 1 час 9 минут
Спасибо всем, кажись работает

Добавлено через 21 секунду

Visual Basic

....
If Not (ws Is wsr) Then
                mass() = ws.Range("A12:H" & ws.Range("A12").CurrentRegion.Rows.Count + 1).Value
                For i = 1 To UBound(mass, 1)
                    If Not IsEmpty(mass(i, 3)) And IsNumeric(mass(i, 3)) Then
                        t = mass(i, 1) & "|" & mass(i, 2)
                        If Not .exists(t) Then
                            j = j + 1
                            .Item(t) = j
                            wsr.Range("A" & j).Value = mass(i, 1)
                            wsr.Range("B" & j).Value = mass(i, 2)
                            wsr.Range("C" & j).Value = mass(i, 8)
                                
                           Else
                            x = .Item(t)
                            wsr.Range("C" & x).Value = wsr.Range("C" & x).Value + mass(i, 8)
                          
                        End If
....

@Hugo121 · 16.01.2019, 11:53

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

@evsmm · 12.03.2019, 16:55 **[ТС]**

Вновь столкнулся с проблемой: Как пробежаться по определенным листам книги?

Порядок листов таков: Главная-Прайс-Исходники-Админ-Лист1-Ком-Ком1-Заявка-1-2-3-4-5-6-....-n

собрать данные с 1-2-3-4-5-6-....-n в лист''Заявка"

@Казанский · 12.03.2019, 19:23

evsmm,

Visual Basic

Dim m As Long, ws As Worksheet
  On Error Resume Next
  For m = 1 To 999
    Set ws = Worksheets(CStr(m))
    If Err Then Exit For
      'работа с листом ws
  Next
  'продолжение банкета

@evsmm · 12.03.2019, 20:37 **[ТС]**

Ув. Казанский, как-то всё замечательно, но данный код не исключает нужные мне листы Главная-Прайс-Исходники-Админ-Лист1-Ком-Ком1.

Он всё равно собирает значения со всех листов((

Не могли Вы помочь мне разобраться с этим вопросом, заранее спасибо.

Visual Basic

Sub Çàÿâêà()
 
Dim m As Long, ws As Worksheet, wsr As Worksheet, mass(), i As Long, j As Long, t$, x&
  On Error Resume Next
  
  For m = 1 To 999
    Set ws = Worksheets(CStr(m))
    If Err Then Exit For
    
        Application.ScreenUpdating = False
        
        Set wsr = Sheets("Çàÿâêà")
    
        wsr.Range("A5:E" & wsr.Range("A5").CurrentRegion.Rows.Count).Clear
        j = 4
 
        With CreateObject("Scripting.Dictionary")
            .comparemode = 1
            For Each ws In ActiveWorkbook.Worksheets
                If Not (ws Is wsr) Then
                    mass() = ws.Range("A12:C" & ws.Range("A12").CurrentRegion.Rows.Count + 1).Value
                    For i = 1 To UBound(mass, 1)
                        If Not IsEmpty(mass(i, 3)) And IsNumeric(mass(i, 3)) Then
                            t = mass(i, 1) & "|" & mass(i, 2)
                            If Not .exists(t) Then
                                j = j + 1
                                .Item(t) = j
                                wsr.Range("A" & j).Value = mass(i, 1)
                                wsr.Range("B" & j).Value = mass(i, 2)
                                wsr.Range("C" & j).Value = mass(i, 3)
                            Else
                                x = .Item(t)
                                wsr.Range("C" & x).Value = wsr.Range("C" & x).Value + mass(i, 3)
                            End If
                        End If
                    Next i
                End If
            Next
        End With
 
        Application.ScreenUpdating = True
  Next
  
End Sub

@Hugo121 · 13.03.2019, 09:25

Сообщение от Казанский

'работа с листом ws

А Вы с каким работаете?

@evsmm · 13.03.2019, 09:54 **[ТС]**

Здравствуйте Hugo121, хочу перебирать листы с названиями 1,2,3,4 и т.д. ... n, заранее не знаю кол-во листов.

Порядок листов таков: Главная-Прайс-Исходники-Админ-Лист1-Ком-Ком1-Заявка-1-2-3-4-5-6-....-n

собрать данные с 1-2-3-4-5-6-....-n в лист''Заявка". В переведенном коде выше он перебирает все листы и копирует данные в лист''Заявка". Успешно исправил данный дефект (т.е.) убрал с листов Главная-Прайс-Исходники-Админ-Лист1-Ком-Ком1 значения с диапазона ws.Range("A12:C" & ws.Range("A12").CurrentRegion.Rows.Count + 1).Value. Но хотелось бы разобраться почему данный код не обращается только к листам с названиями 1,2,3,4 и т.д. ... n

И ещё один вопрос? Не могли вы мне помочь разобраться (т.е.) расписать создания словаря CreateObject("Scripting.Dictionary").

Заранее благодарен. Спасибо

@Казанский · 13.03.2019, 10:27

evsmm, цикл For m = 1 To 999 должен был быть ВМЕСТО цикла по всем листам, т.е.
For Each ws In ActiveWorkbook.Worksheets
На самом деле можете просто вместо If Not (ws Is wsr) Then поставить

Visual Basic

1	If isnumeric(ws.name) Then

@Burk 1846 / 1161 / 354 Регистрация: 11.07.2014 Сообщений: 4,102
	13.01.2019, 15:59	2
	evsmm, если у вас не хватает знаний чтобы хотя начать делать, то обратитесь в раздел Фриланс этого форума, но перед этим дайте прочитать написанное вами своему приятелю, который малость разбирается в ВБА. Если он поймет ваши объяснения без доппояснений, то кто-то из вас шибко умный, а я ниже плинтуса. 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	13.01.2019, 21:40	6
	Самое простое - собирать всё в словарь. Ну или в словаре хранить индекс, а по нему в массиве (ну или в данном случае проще сразу на листе) суммировать. 0

@evsmm 1 / 1 / 0 Регистрация: 09.01.2019 Сообщений: 34
	13.01.2019, 21:46 [ТС]	7
	я так понимаю лучше по формуле: =СУММ('1'!C12+'1 (2)'!C12) и т.д. по всем листам и не мучатся писать массивы, выборки, а сделать все через ссылки на страницы))) 0

@evsmm 1 / 1 / 0 Регистрация: 09.01.2019 Сообщений: 34
	13.01.2019, 21:53 [ТС]	9
	Спасибо буду разбираться с вашей программой что это такое и с чем его едят. Возникнут вопросы, а они возникнут буду задавать. И на этом огромное спасибо. 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	14.01.2019, 15:07	11
	wsr.Range("A5").CurrentRegion.Rows.Count - это то, что тут написано: количество строк неразрывного диапазона ячейки А5. Это число подставляется в адрес очищаемого диапазона "A5:E..". Причём это количество строк считается не от А5, а от первой строки этого диапазона! Если что-то не очищается - смотрите какое число подставляете. И я тут ничего не менял, и не смотрел на счёт косяков. P.S. А вообще можно (судя по примеру) не заморачиваться подсчётом, а тупо очищать всё 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	16.01.2019, 11:53	14
	evsmm, когда массив получается длинный и широкий - он может не влезть в память. Тогда делайте несколько массивов, не берите в них лишнее. Тут лишних 5 столбцов таскаете. 0

@evsmm 1 / 1 / 0 Регистрация: 09.01.2019 Сообщений: 34
	12.03.2019, 16:55 [ТС]	15
	Вновь столкнулся с проблемой: Как пробежаться по определенным листам книги? Порядок листов таков: Главная-Прайс-Исходники-Админ-Лист1-Ком-Ком1-Заявка-1-2-3-4-5-6-....-n собрать данные с 1-2-3-4-5-6-....-n в лист''Заявка" 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	13.03.2019, 09:25	18
	Сообщение от Казанский 'работа с листом ws А Вы с каким работаете? 0

@evsmm 1 / 1 / 0 Регистрация: 09.01.2019 Сообщений: 34
	13.03.2019, 09:54 [ТС]	19
	Здравствуйте Hugo121, хочу перебирать листы с названиями 1,2,3,4 и т.д. ... n, заранее не знаю кол-во листов. Порядок листов таков: Главная-Прайс-Исходники-Админ-Лист1-Ком-Ком1-Заявка-1-2-3-4-5-6-....-n собрать данные с 1-2-3-4-5-6-....-n в лист''Заявка". В переведенном коде выше он перебирает все листы и копирует данные в лист''Заявка". Успешно исправил данный дефект (т.е.) убрал с листов Главная-Прайс-Исходники-Админ-Лист1-Ком-Ком1 значения с диапазона ws.Range("A12:C" & ws.Range("A12").CurrentRegion.Rows.Count + 1).Value. Но хотелось бы разобраться почему данный код не обращается только к листам с названиями 1,2,3,4 и т.д. ... n И ещё один вопрос? Не могли вы мне помочь разобраться (т.е.) расписать создания словаря CreateObject("Scripting.Dictionary"). Заранее благодарен. Спасибо 0

Различная выборка из диапазона столбца нескольких значений разного множества листов и копирование в сводные таблицы

Решение