Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Подстановка данных из массива в последнюю строку к критериям - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Подстановка данных из массива в последнюю строку к критериям (Макросы/Sub)
Подстановка данных из массива в последнюю строку к критериям
Grimmm Дата: Воскресенье, 29.05.2022, 17:19 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Здравствуйте, прошу подсказать, как можно изменить макрос, чтобы он вставлял информацию в последнюю ячейку в столбце "Итого" после того как собрал информацию по критериям.
Например по критерию столбца "Артикул" - 123011 + столбец "Город" - Москва, сохранял не в D8, а в D26, т.е. к последней строке с идентичными критериями.
Спасибо большое за помощь!

[vba]
Код
Option Explicit

Sub abc()
    Dim r, lr, m, z1, z2, z3, t
    Dim sl: Set sl = CreateObject("Scripting.Dictionary")
    With ActiveSheet
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        m = .Cells(1, 1).Resize(lr, 4).Value
        For r = 3 To UBound(m)
            z3 = m(r, 3)
            If Len(z3) > 0 Then
                z1 = m(r, 1)
                z2 = m(r, 2)
                t = z1 & "|" & z2
                If sl.exists(t) Then
                    sl(t) = sl(t) & Chr(10) & z3
                Else
                    sl(t) = z3
                End If
            End If
        Next r

    
        For r = 3 To UBound(m)
            z1 = m(r, 1)
            z2 = m(r, 2)
            t = z1 & "|" & z2
            If sl.exists(t) Then
                .Cells(r, 4) = sl(t)
                sl.Remove (t)
            End If
        Next r
    End With
End Sub

[/vba]
К сообщению приложен файл: 0644221.xlsm(16.5 Kb)


Сообщение отредактировал Grimmm - Воскресенье, 29.05.2022, 18:00
 
Ответить
СообщениеЗдравствуйте, прошу подсказать, как можно изменить макрос, чтобы он вставлял информацию в последнюю ячейку в столбце "Итого" после того как собрал информацию по критериям.
Например по критерию столбца "Артикул" - 123011 + столбец "Город" - Москва, сохранял не в D8, а в D26, т.е. к последней строке с идентичными критериями.
Спасибо большое за помощь!

[vba]
Код
Option Explicit

Sub abc()
    Dim r, lr, m, z1, z2, z3, t
    Dim sl: Set sl = CreateObject("Scripting.Dictionary")
    With ActiveSheet
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        m = .Cells(1, 1).Resize(lr, 4).Value
        For r = 3 To UBound(m)
            z3 = m(r, 3)
            If Len(z3) > 0 Then
                z1 = m(r, 1)
                z2 = m(r, 2)
                t = z1 & "|" & z2
                If sl.exists(t) Then
                    sl(t) = sl(t) & Chr(10) & z3
                Else
                    sl(t) = z3
                End If
            End If
        Next r

    
        For r = 3 To UBound(m)
            z1 = m(r, 1)
            z2 = m(r, 2)
            t = z1 & "|" & z2
            If sl.exists(t) Then
                .Cells(r, 4) = sl(t)
                sl.Remove (t)
            End If
        Next r
    End With
End Sub

[/vba]

Автор - Grimmm
Дата добавления - 29.05.2022 в 17:19
msi2102 Дата: Понедельник, 30.05.2022, 09:23 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 134
Репутация: 65 ±
Замечаний: 0% ±

Excel 2007
Попробуйте так:
[vba]
Код
Sub abc()
    Dim r, lr, m, z3, t
    Dim sl
    Set sl = CreateObject("Scripting.Dictionary")
    With ActiveSheet
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        m = .Cells(1, 1).Resize(lr, 4).Value
        For r = 3 To UBound(m)
            z3 = m(r, 3)
            If Len(z3) > 0 Then
                t = m(r, 1) & "|" & m(r, 2)
                If sl.exists(t) Then
                    sl(t) = sl(t) & Chr(10) & z3
                Else
                    sl(t) = z3
                End If
            End If
        Next r
        For r = UBound(m) To 3 Step -1
            t = m(r, 1) & "|" & m(r, 2)
            If sl.exists(t) Then
                .Cells(r, 4) = sl(t)
                sl.Remove (t)
            End If
        Next r
    End With
End Sub
[/vba]
К сообщению приложен файл: 7962411.xlsm(16.8 Kb)
 
Ответить
СообщениеПопробуйте так:
[vba]
Код
Sub abc()
    Dim r, lr, m, z3, t
    Dim sl
    Set sl = CreateObject("Scripting.Dictionary")
    With ActiveSheet
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        m = .Cells(1, 1).Resize(lr, 4).Value
        For r = 3 To UBound(m)
            z3 = m(r, 3)
            If Len(z3) > 0 Then
                t = m(r, 1) & "|" & m(r, 2)
                If sl.exists(t) Then
                    sl(t) = sl(t) & Chr(10) & z3
                Else
                    sl(t) = z3
                End If
            End If
        Next r
        For r = UBound(m) To 3 Step -1
            t = m(r, 1) & "|" & m(r, 2)
            If sl.exists(t) Then
                .Cells(r, 4) = sl(t)
                sl.Remove (t)
            End If
        Next r
    End With
End Sub
[/vba]

Автор - msi2102
Дата добавления - 30.05.2022 в 09:23
Grimmm Дата: Вторник, 31.05.2022, 06:02 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

msi2102, проверил, да спасибо работает, только информацию со второй строки пропускает и не вставляет, оставляет пустой
 
Ответить
Сообщениеmsi2102, проверил, да спасибо работает, только информацию со второй строки пропускает и не вставляет, оставляет пустой

Автор - Grimmm
Дата добавления - 31.05.2022 в 06:02
msi2102 Дата: Вторник, 31.05.2022, 09:38 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 134
Репутация: 65 ±
Замечаний: 0% ±

Excel 2007
со второй строки пропускает и не вставляет, оставляет пустой

не совсем Вас понимаю :(
В ячейку D26 вставляются значения "Микроволновка, утюг", потому что сочетание 123011-Москва встречается дважды, в одном - микроволновка, в другом - утюг. Согласно первому сообщению:

чтобы он вставлял информацию в последнюю ячейку в столбце "Итого"

сохранял не в D8, а в D26, т.е. к последней строке с идентичными критериями

На данном этапе так и есть или нужно как-то по другому, покажите в примере как должно быть
 
Ответить
Сообщение
со второй строки пропускает и не вставляет, оставляет пустой

не совсем Вас понимаю :(
В ячейку D26 вставляются значения "Микроволновка, утюг", потому что сочетание 123011-Москва встречается дважды, в одном - микроволновка, в другом - утюг. Согласно первому сообщению:

чтобы он вставлял информацию в последнюю ячейку в столбце "Итого"

сохранял не в D8, а в D26, т.е. к последней строке с идентичными критериями

На данном этапе так и есть или нужно как-то по другому, покажите в примере как должно быть

Автор - msi2102
Дата добавления - 31.05.2022 в 09:38
Grimmm Дата: Вторник, 31.05.2022, 09:49 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

msi2102, все прекрасно работает, только пропускает строку 2,в ячейке C3 когда присутствует комментарий, он его не забирает и не вставляет в ячейку D2. Всё остальное работает отлично как и нужно.
 
Ответить
Сообщениеmsi2102, все прекрасно работает, только пропускает строку 2,в ячейке C3 когда присутствует комментарий, он его не забирает и не вставляет в ячейку D2. Всё остальное работает отлично как и нужно.

Автор - Grimmm
Дата добавления - 31.05.2022 в 09:49
msi2102 Дата: Вторник, 31.05.2022, 09:58 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 134
Репутация: 65 ±
Замечаний: 0% ±

Excel 2007
Ну всё верно, так и должно быть. Видите у Вас в самом первом коде два цикла, они начинаются с 3, нужно заменить на 2, скорее всего у Вас данные в оригинале начинаются с третьей строки, а в примере со второй, замените:
[vba]
Код
For r = 3 To UBound(m)
[/vba]
на
[vba]
Код
For r = 2 To UBound(m)
[/vba]
и
[vba]
Код
For r = UBound(m) To 3 Step -1
[/vba]
на
[vba]
Код
For r = UBound(m) To 2 Step -1
[/vba]
К сообщению приложен файл: 0071320.xlsm(16.8 Kb)


Сообщение отредактировал msi2102 - Вторник, 31.05.2022, 09:59
 
Ответить
СообщениеНу всё верно, так и должно быть. Видите у Вас в самом первом коде два цикла, они начинаются с 3, нужно заменить на 2, скорее всего у Вас данные в оригинале начинаются с третьей строки, а в примере со второй, замените:
[vba]
Код
For r = 3 To UBound(m)
[/vba]
на
[vba]
Код
For r = 2 To UBound(m)
[/vba]
и
[vba]
Код
For r = UBound(m) To 3 Step -1
[/vba]
на
[vba]
Код
For r = UBound(m) To 2 Step -1
[/vba]

Автор - msi2102
Дата добавления - 31.05.2022 в 09:58
Grimmm Дата: Четверг, 02.06.2022, 06:02 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

msi2102, да большое спасибо разобрался теперь, все отлично работает
 
Ответить
Сообщениеmsi2102, да большое спасибо разобрался теперь, все отлично работает

Автор - Grimmm
Дата добавления - 02.06.2022 в 06:02
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Подстановка данных из массива в последнюю строку к критериям (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2022 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!