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

Вход

Регистрация

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

 

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

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вывести в одну ячейку значения ячеек с определенными условия (Макросы/Sub)
Вывести в одну ячейку значения ячеек с определенными условия
SSre Дата: Суббота, 15.05.2021, 07:51 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 2 ±
Замечаний: 0% ±

Доброго времени суток.
Имеются столбцы с данными: A B C и ячейки с условиями D3, E1, F1, G1, H1, I1
Необходимо в ячейках E3, F3, G3, H3, I3 получить ответ исходя из условий.
"пример для ячейки E3":
ищет в столбце B все строки соответствующие дате из E1 (20.01.2021),
проверяет, что у найденных строк в столбце С стоит цифра соответствующая ячейке D3,
вписывает все подходящие значения из столбца А в ячейку E3,
при этом если у номеров в столбце А (№) имеется последовательность (1, 2, 3, 12) то пишет значение диапазоном 1-3, 12 (в ячейке G3 нет диапазона, т.ч. пишет 6, 13, 7)


На одном из форумов, с похожей тематикой, предложили следующий макрос. К сожалению, эксель ругается на строку и макрос с ней не работает.

[vba]
Код
ActiveWorkbook.Worksheets("Лист2").Sort.SortFields.Add2 Key:=Range("A3:A" & lr) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
[/vba]
Если удалить строку - работает, но данные не выводятся диапазоном (1-3, 12, а пишется, 1-2-3, 12)
Не могу понять, в чем проблема. Файл прикрепил.

[vba]
Код
Sub mrshkei()
Dim arr, arr2, arr3, i As Long, n As Long, lr As Long, lcol As Long, tt As String, col As New Collection
lr = Cells(Rows.Count, 1).End(xlUp).Row
lcol = Cells(1, Columns.Count).End(xlToLeft).Column
    Range("A2:C" & lr).Select
    ActiveWorkbook.Worksheets("Лист2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист2").Sort.SortFields.Add2 Key:=Range("A3:A" & lr) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист2").Sort
        .SetRange Range("A2:C" & lr)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
arr = Range("A3:C" & lr)
arr2 = Range(Cells(1, 5), Cells(1, lcol))
ReDim arr3(1 To 1, 1 To UBound(arr2, 2) - LBound(arr2) + 1): K = 1
For i = LBound(arr2) To UBound(arr2, 2) - LBound(arr2) + 1
tt = ""
Set col = Nothing
    For n = LBound(arr) To UBound(arr)
        If arr2(1, i) = arr(n, 2) And arr(n, 3) = [D3] Then
            On Error Resume Next
            col.Add arr(n, 1), CStr(arr(n, 1))
        End If
    Next n
    For n = col.Count To 1 Step -1
        If tt = "" Then
            tt = col(n)
        Else
            If col(n + 1) = col(n) + 1 Then
                tt = col(n) & " - " & tt
            Else
                tt = col(n) & ", " & tt
            End If
        End If
    Next n
    arr3(1, K) = tt: K = K + 1
Next i
Range("E3").Resize(1, UBound(arr3, 2) - LBound(arr3) + 1).NumberFormat = "@"
Range("E3").Resize(1, UBound(arr3, 2) - LBound(arr3) + 1) = arr3
End Sub
[/vba]
К сообщению приложен файл: 321-1-.xlsm(25.4 Kb) · 3326751.jpg(31.9 Kb)


Сообщение отредактировал SSre - Суббота, 15.05.2021, 07:52
 
Ответить
СообщениеДоброго времени суток.
Имеются столбцы с данными: A B C и ячейки с условиями D3, E1, F1, G1, H1, I1
Необходимо в ячейках E3, F3, G3, H3, I3 получить ответ исходя из условий.
"пример для ячейки E3":
ищет в столбце B все строки соответствующие дате из E1 (20.01.2021),
проверяет, что у найденных строк в столбце С стоит цифра соответствующая ячейке D3,
вписывает все подходящие значения из столбца А в ячейку E3,
при этом если у номеров в столбце А (№) имеется последовательность (1, 2, 3, 12) то пишет значение диапазоном 1-3, 12 (в ячейке G3 нет диапазона, т.ч. пишет 6, 13, 7)


На одном из форумов, с похожей тематикой, предложили следующий макрос. К сожалению, эксель ругается на строку и макрос с ней не работает.

[vba]
Код
ActiveWorkbook.Worksheets("Лист2").Sort.SortFields.Add2 Key:=Range("A3:A" & lr) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
[/vba]
Если удалить строку - работает, но данные не выводятся диапазоном (1-3, 12, а пишется, 1-2-3, 12)
Не могу понять, в чем проблема. Файл прикрепил.

[vba]
Код
Sub mrshkei()
Dim arr, arr2, arr3, i As Long, n As Long, lr As Long, lcol As Long, tt As String, col As New Collection
lr = Cells(Rows.Count, 1).End(xlUp).Row
lcol = Cells(1, Columns.Count).End(xlToLeft).Column
    Range("A2:C" & lr).Select
    ActiveWorkbook.Worksheets("Лист2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист2").Sort.SortFields.Add2 Key:=Range("A3:A" & lr) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист2").Sort
        .SetRange Range("A2:C" & lr)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
arr = Range("A3:C" & lr)
arr2 = Range(Cells(1, 5), Cells(1, lcol))
ReDim arr3(1 To 1, 1 To UBound(arr2, 2) - LBound(arr2) + 1): K = 1
For i = LBound(arr2) To UBound(arr2, 2) - LBound(arr2) + 1
tt = ""
Set col = Nothing
    For n = LBound(arr) To UBound(arr)
        If arr2(1, i) = arr(n, 2) And arr(n, 3) = [D3] Then
            On Error Resume Next
            col.Add arr(n, 1), CStr(arr(n, 1))
        End If
    Next n
    For n = col.Count To 1 Step -1
        If tt = "" Then
            tt = col(n)
        Else
            If col(n + 1) = col(n) + 1 Then
                tt = col(n) & " - " & tt
            Else
                tt = col(n) & ", " & tt
            End If
        End If
    Next n
    arr3(1, K) = tt: K = K + 1
Next i
Range("E3").Resize(1, UBound(arr3, 2) - LBound(arr3) + 1).NumberFormat = "@"
Range("E3").Resize(1, UBound(arr3, 2) - LBound(arr3) + 1) = arr3
End Sub
[/vba]

Автор - SSre
Дата добавления - 15.05.2021 в 07:51
Pelena Дата: Суббота, 15.05.2021, 19:16 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 17624
Репутация: 3925 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Здравствуйте.
Так хотели?
К сообщению приложен файл: 0766462.xlsm(24.9 Kb)


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеЗдравствуйте.
Так хотели?

Автор - Pelena
Дата добавления - 15.05.2021 в 19:16
SSre Дата: Суббота, 15.05.2021, 21:03 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 2 ±
Замечаний: 0% ±

Так хотели?

Добрый вечер!
Большое спасибо! Макрос выводит именно то, что требовалось (диапазон значений, там, где это возможно).
В ходе изучения кода и результатов выяснил, что фильтрация диапазона данных по столбцу "А" мне не нужна, т.к. мешает обрабатывать итоги. Убрал ее.

Не знаю, противоречит мой дополнительный вопрос правилам форума или его можно считать продолжением темы, но все же спрошу:
Что необходимо изменить и на что (как это правильно должно выглядеть), если исходные данные (столбцы A, B, C) будут находиться не на этом листе, а на другом или в другой книге?
Если я правильно понимаю, то сейчас их местоположение задает вот эта строка: arr = Range("A3:C" & lr)
 
Ответить
Сообщение
Так хотели?

Добрый вечер!
Большое спасибо! Макрос выводит именно то, что требовалось (диапазон значений, там, где это возможно).
В ходе изучения кода и результатов выяснил, что фильтрация диапазона данных по столбцу "А" мне не нужна, т.к. мешает обрабатывать итоги. Убрал ее.

Не знаю, противоречит мой дополнительный вопрос правилам форума или его можно считать продолжением темы, но все же спрошу:
Что необходимо изменить и на что (как это правильно должно выглядеть), если исходные данные (столбцы A, B, C) будут находиться не на этом листе, а на другом или в другой книге?
Если я правильно понимаю, то сейчас их местоположение задает вот эта строка: arr = Range("A3:C" & lr)

Автор - SSre
Дата добавления - 15.05.2021 в 21:03
Pelena Дата: Суббота, 15.05.2021, 21:08 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 17624
Репутация: 3925 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Правильно понимаете yes
Если диапазон на другом листе, то надо добавить обращение к листу, например, Sheets("Лист1").Range("A3:C" & lr), а если в другой книге, то ещё и обращение к книге


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеПравильно понимаете yes
Если диапазон на другом листе, то надо добавить обращение к листу, например, Sheets("Лист1").Range("A3:C" & lr), а если в другой книге, то ещё и обращение к книге

Автор - Pelena
Дата добавления - 15.05.2021 в 21:08
SSre Дата: Суббота, 15.05.2021, 21:22 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 2 ±
Замечаний: 0% ±

то надо добавить обращение к листу

Отлично! Оказалось проще, чем я думал.
Еще раз, огромное спасибо!
 
Ответить
Сообщение
то надо добавить обращение к листу

Отлично! Оказалось проще, чем я думал.
Еще раз, огромное спасибо!

Автор - SSre
Дата добавления - 15.05.2021 в 21:22
SSre Дата: Четверг, 20.05.2021, 00:11 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 2 ±
Замечаний: 0% ±

Правильно понимаете

Здравствуйте!
Начал корректировать Ваш код и, похоже, поломал его.. могу я попросить еще об одной услуге/консультации?
Я прикрепил 2 файла (11 и 22), почему при запуске макроса на листе 11 показывает только 24 числа 1-13?
Во-первых с 1 по 13 это 23 число, а не 24
Во-вторых номера 24 числа вообще не показываются

Такое впечатление, что формула не определяет значения ниже по строчкам какого-то определенного момента.
Я хотел проверить, что можно в файл "22" поставить на 1000+ строчку дату и значения, нажать макрос и на файле "11" получить корректный итог.. - не получил, осилить сам причину не смог
[vba]
Код
Sub WWWWW()
    Dim arr, arr2, arr3, arr4, i As Long, n As Long, lr As Long, lcol As Long, tt As String, col As New Collection, fl As Boolean
    Set wb = ThisWorkbook: Set wb2 = Workbooks("22.xlsx")
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    lcol = Cells(14, Columns.Count).End(xlToLeft).Column
    arr = wb2.Sheets(2).Range("A3:AK" & lr)
    arr2 = wb.Sheets(1).Range(Cells(14, 4), Cells(14, lcol))
    arr3 = wb2.Sheets(2).Range("A3:AK" & lr)
    ReDim arr4(1 To 1, 1 To UBound(arr2, 2) - LBound(arr2) + 1): K = 1
    For i = LBound(arr2) To UBound(arr2, 2) - LBound(arr2) + 1
        tt = ""
        Set col = Nothing
        For n = LBound(arr) To UBound(arr)
            If arr2(1, i) = arr(n, 16) And arr(n, 33) = [C17] And arr3(n, 10) = [A15] Then
                On Error Resume Next
                col.Add arr(n, 1), CStr(arr(n, 1))
            End If
        Next n
        For n = 1 To col.Count
            tt = tt & ", " & col(n)
            Do While col(n) = col(n + 1) - 1 And n < col.Count
                fl = True: n = n + 1
                If n >= col.Count Then Exit Do
            Loop
            If fl Then tt = tt & "-" & col(n): fl = False
        Next n
        arr4(1, K) = Mid(tt, 3): K = K + 1
    Next i
    Range("E18").Resize(1, UBound(arr4, 2) - LBound(arr4) + 1).NumberFormat = "@"
    Range("E18").Resize(1, UBound(arr4, 2) - LBound(arr4) + 1) = arr4
End Sub
[/vba]
К сообщению приложен файл: 11.xlsm(21.3 Kb) · 5017995.xlsx(13.5 Kb)
 
Ответить
Сообщение
Правильно понимаете

Здравствуйте!
Начал корректировать Ваш код и, похоже, поломал его.. могу я попросить еще об одной услуге/консультации?
Я прикрепил 2 файла (11 и 22), почему при запуске макроса на листе 11 показывает только 24 числа 1-13?
Во-первых с 1 по 13 это 23 число, а не 24
Во-вторых номера 24 числа вообще не показываются

Такое впечатление, что формула не определяет значения ниже по строчкам какого-то определенного момента.
Я хотел проверить, что можно в файл "22" поставить на 1000+ строчку дату и значения, нажать макрос и на файле "11" получить корректный итог.. - не получил, осилить сам причину не смог
[vba]
Код
Sub WWWWW()
    Dim arr, arr2, arr3, arr4, i As Long, n As Long, lr As Long, lcol As Long, tt As String, col As New Collection, fl As Boolean
    Set wb = ThisWorkbook: Set wb2 = Workbooks("22.xlsx")
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    lcol = Cells(14, Columns.Count).End(xlToLeft).Column
    arr = wb2.Sheets(2).Range("A3:AK" & lr)
    arr2 = wb.Sheets(1).Range(Cells(14, 4), Cells(14, lcol))
    arr3 = wb2.Sheets(2).Range("A3:AK" & lr)
    ReDim arr4(1 To 1, 1 To UBound(arr2, 2) - LBound(arr2) + 1): K = 1
    For i = LBound(arr2) To UBound(arr2, 2) - LBound(arr2) + 1
        tt = ""
        Set col = Nothing
        For n = LBound(arr) To UBound(arr)
            If arr2(1, i) = arr(n, 16) And arr(n, 33) = [C17] And arr3(n, 10) = [A15] Then
                On Error Resume Next
                col.Add arr(n, 1), CStr(arr(n, 1))
            End If
        Next n
        For n = 1 To col.Count
            tt = tt & ", " & col(n)
            Do While col(n) = col(n + 1) - 1 And n < col.Count
                fl = True: n = n + 1
                If n >= col.Count Then Exit Do
            Loop
            If fl Then tt = tt & "-" & col(n): fl = False
        Next n
        arr4(1, K) = Mid(tt, 3): K = K + 1
    Next i
    Range("E18").Resize(1, UBound(arr4, 2) - LBound(arr4) + 1).NumberFormat = "@"
    Range("E18").Resize(1, UBound(arr4, 2) - LBound(arr4) + 1) = arr4
End Sub
[/vba]

Автор - SSre
Дата добавления - 20.05.2021 в 00:11
Pelena Дата: Четверг, 20.05.2021, 08:12 | Сообщение № 7
Группа: Админы
Ранг: Местный житель
Сообщений: 17624
Репутация: 3925 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Здравствуйте.
Вот в этой строчке тоже надо указывать к какой книге и к какому листу обращаетесь
[vba]
Код
    lr = wb2.Sheets("2").Cells(Rows.Count, 1).End(xlUp).Row
[/vba]иначе последняя заполненная строка определяется по книге 11


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеЗдравствуйте.
Вот в этой строчке тоже надо указывать к какой книге и к какому листу обращаетесь
[vba]
Код
    lr = wb2.Sheets("2").Cells(Rows.Count, 1).End(xlUp).Row
[/vba]иначе последняя заполненная строка определяется по книге 11

Автор - Pelena
Дата добавления - 20.05.2021 в 08:12
SSre Дата: Четверг, 20.05.2021, 20:54 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 14
Репутация: 2 ±
Замечаний: 0% ±

Вот в этой строчке тоже надо указывать к какой книге и к какому листу обращаетесь

Благодарю! Все перерыл, это не увидел..
 
Ответить
Сообщение
Вот в этой строчке тоже надо указывать к какой книге и к какому листу обращаетесь

Благодарю! Все перерыл, это не увидел..

Автор - SSre
Дата добавления - 20.05.2021 в 20:54
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вывести в одну ячейку значения ячеек с определенными условия (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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