Вывести список значений в сообщение

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Вывести список значений в сообщение (Макросы/Sub)

ant6729

Дата: Воскресенье, 16.09.2018, 22:00 | Сообщение № 1

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

Всем привет, встретил такую ситуацию

В первой колонке с 1 по 12 ячейки цифры

1
2
3
4
5
6
7
8
9
10
11
12

Как вывести это в MsgBox списком?
Что - то как-то никак...

По идее пробовался через arrray
Через коллекции
Ничего
Покажите, пожалуйста, как это можно было бы сделать.

Ответить

Roman777

Дата: Воскресенье, 16.09.2018, 22:06 | Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

ant6729, используйте цикл:
[vba]

Код

Dim s as string
for i =1 to 12
s = s& cells(i,1) & chr(13)
next i
msgbox(s)

[/vba]

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Воскресенье, 16.09.2018, 22:06

Ответить

ant6729

Дата: Воскресенье, 16.09.2018, 22:11 | Сообщение № 3

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

Спасибо!!
чуть переправил

Ответить

Kuzmich

Дата: Воскресенье, 16.09.2018, 22:13 | Сообщение № 4

Группа: Проверенные

Ранг: Ветеран

Сообщений: 717

Репутация: 159 ±

Замечаний: 0% ±

Excel 2003

[vba]

Код

Sub iMsgBox()
Dim arr
Dim i As Long
Dim tmp As String
  arr = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
  For i = 1 To UBound(arr)
    tmp = tmp & arr(i, 1) & vbCrLf
  Next
   MsgBox tmp
End Sub

[/vba]

Ответить

_Boroda_

Дата: Воскресенье, 16.09.2018, 23:01 | Сообщение № 5

Группа: Админы

Ранг: Местный житель

Сообщений: 17006

Репутация: 6667 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Без циклов
[vba]

Код

Sub tt()
MsgBox Join(Application.Transpose([A1:A12]), ", ")
End Sub

[/vba]
С поиском последней заполненной
[vba]

Код

MsgBox Join(Application.Transpose(Cells(1).Resize(Cells(Rows.Count, 1).End(3).Row)), ", ")

[/vba]

*На всякий случай - не забудьте, что в MsgBox влезает 1023 символа

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

ant6729

Дата: Понедельник, 17.09.2018, 00:43 | Сообщение № 6

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

А есть возможность вывести в msgbox только уникальные ? Или такие возможности только в коллекциях?

Возможно, можно где-нибудь здесь [vba]

Код

MsgBox Join(Application.Transpose([A1:A12]), vbCrLf)

[/vba] использовать unique...)...

Ответить

StoTisteg

Дата: Понедельник, 17.09.2018, 10:41 | Сообщение № 7

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

Цитата ant6729, 17.09.2018 в 00:43, в сообщении № 6 ()

Или такие возможности только в коллекциях?

Вот как раз в коллекции-то такой возможности и нет, только в словаре.[vba]

Код

Sub Otp()

   Dim i As Integer
   Dim slov As Object

   Set slov = CreateObject("Scripting.Dictionary")
   For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
      On Error Resume Next
      slov.Add Cells(i, 1).Value, ""
   Next i
   MsgBox Join(slov.keys(), ", ")

End Sub

[/vba]

К сообщению приложен файл: Msgbox.xlsm (13.9 Kb)

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Сообщение отредактировал StoTisteg - Понедельник, 17.09.2018, 11:07

Ответить

ant6729

Дата: Понедельник, 17.09.2018, 14:46 | Сообщение № 8

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

Спасибо...
А то я опять круговерть начал в перерывах между работой

Залез в RemoveDupes ... там и потух)

Спасибо!!

Ответить

_Boroda_

Дата: Понедельник, 17.09.2018, 15:03 | Сообщение № 9

Группа: Админы

Ранг: Местный житель

Сообщений: 17006

Репутация: 6667 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Еще вариант на словаре
[vba]

Код

Sub tt()
    r1_ = Cells(Rows.Count, 1).End(3).Row
    ar = Cells(1).Resize(r1_)
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        For i = 1 To r1_
            aaa = .Item(ar(i, 1))
        Next i
        MsgBox Join(.keys(), ", ")
    End With
End Sub

[/vba]

Ответить

StoTisteg

Дата: Понедельник, 17.09.2018, 16:14 | Сообщение № 10

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

Цитата ant6729, 17.09.2018 в 14:46, в сообщении № 8 ()

Залез в RemoveDupes ...

Можно и так...[vba]

Код

Sub Otp2()

ActiveSheet.UsedRange.RemoveDuplicates Columns:=1
MsgBox Join(Application.Transpose(Cells(1).Resize(Cells(Rows.Count, 1).End(3).Row)), ", ")

End Sub

[/vba]Только если в боевом файле колонок не одна и строки не полностью повторяются, то он испортится, так что лучше предварительно выводимую колонку скопировать на дополнительный лист.

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

ant6729

Дата: Понедельник, 17.09.2018, 20:13 | Сообщение № 11

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

Блин... все -таки это было возможно... !)

Спасибо, всем - настоящие профи... есть что подсмотреть...

Ответить

_Boroda_

Дата: Понедельник, 17.09.2018, 21:01 | Сообщение № 12

Группа: Админы

Ранг: Местный житель

Сообщений: 17006

Репутация: 6667 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Цитата ant6729, 17.09.2018 в 20:13, в сообщении № 11 ()

все -таки это было возможно... !)

Конечно возможно. Вы б спросили, Вам бы сразу сказали
[vba]

Код

Sub ee()
    Application.ScreenUpdating = 0
    Application.Calculation = xlCalculationManual
    r1_ = Cells(Rows.Count, 1).End(3).Row
    ar = Cells(1).Resize(r1_)
    With Cells(1).SpecialCells(xlLastCell).Offset(1, 1).Resize(r1_)
        With .Parent.UsedRange: End With
        .Value = ar
        .RemoveDuplicates Columns:=1
        r11_ = Cells(Rows.Count, .Column).End(3).Row
        t_ = Join(Application.Transpose(.Cells(1).Resize(r11_ - .Row + 1)), ", ")
        .Clear
        With .Parent.UsedRange: End With
    End With
    MsgBox t_
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = 1
End Sub

[/vba]

Ответить

Вывести список значений в сообщение (Макросы/Sub)

Страница 1 из 1
1