Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Как правильно перенести данные из массива в комментарий, оптимизация макроса
 
#1
04.12.2021 20:24:45
Здравствуйте!

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

Имеем диапазон
r1 = Range("A1:D10")
arr1 - массив с уникальными элементами (для каждой ячейки диапазона r1 будут свои данные)

Сейчас я использую следующую последовательность:
1) Данные из массива выгружаются в диапазон ячеек
Код
    r1.Resize(1, UBound(arr1, 2)) = arr1
2) Цикл по всем ячейкам диапазона -> перенос данных из непустых ячеек в комментарий этих ячеек
Код
    For Each c In r1
    On Error Resume Next
           c.Comment.Delete
           If c <> "" Then
              c.AddComment CStr(c.Value)
           End If
    Next

Прошу прощения, если описал сумбурно и не очень понятно (допишу, если будут какие-то вопросы).
Изменено: Fylhtqq - 05.12.2021 18:34:45
 
 
 
#2
04.12.2021 20:45:25
, я бы предпочел смотреть файл-пример с исходными данными и рядом что хотите получитm на выходе

[CODE][/CODE]
Изменено: Mershik - 04.12.2021 20:50:27
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
04.12.2021 21:16:26
1. комментарии снести сразу у всего диапазона одной командой
2. For Each c In r1.Specialcells(константы у вас там или формулы).Cells и тогда будет цикл строго по "правильным" ячейкам значение из каждой внести в комментарий
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#4
05.12.2021 18:34:27
Добрый вечер!

Цитата
написал:
я бы предпочел смотреть файл-пример с исходными данными и рядом что хотите получитm на выходе
Прикрепил файл к первому посту.
Для примера упростил массив с данными (задал через диапазон), в реально задаче там значительно больше данных. Из--за этого и хочется уйти от цикла по ячейкам при внесении комментариев.
Код
arr1 = Range("O1:R10")

Цитата
написал:
1. комментарии снести сразу у всего диапазона одной командой2. For Each c In r1.Specialcells(константы у вас там или формулы).Cells и тогда будет цикл строго по "правильным" ячейкам значение из каждой внести в комментарий
Не уверен, что правильно вас понял. Т.е. перенести данные из массива сразу в комментарии ячеек, а не в сами ячейки нельзя? Все-равно необходимо по ячейкам проходить?
Под занесением данных из массива "сразу в ячейку" я говорю про:
Код
r1.Resize(10, UBound(arr1, 2)) = arr1
Т.е. хотелось бы получить, что-то на подобие (понятно, что так не работает):
Код
r1.Resize(10, UBound(arr1, 2)).AddComment = arr1
 
 
 
#5
05.12.2021 19:25:22
Цитата
написал:
перенести данные из массива сразу в комментарии ячеек, а не в сами ячейки нельзя?
А чего нужно-то? Постарайтесь объяснить.
Текст комментария хранить в ячейке?
Цитата
написал:
хочется уйти от цикла по ячейкам при внесении комментариев
Ну и задавайте адрес сразу... :)  И Find никто не отменял...  :)
 
 
 
#6
05.12.2021 19:59:16
Цитата
написал:
А чего нужно-то? Постарайтесь объяснить. Текст комментария хранить в ячейке?

Я прикрепил файл с примерном (к первому сообщению). На листе1 есть диапазон O1:R10, которому соответствует двумерный массив arr1 (1to10, 1to4)
Мне нужно перенести данные из массива (именно из массива, т.к. диапазон O1:R10 приведен просто для наглядности) в комментарии ячеек диапазона A1:D10

Т.е. должно быть что-то на подобие:
[A1].AddComment CStr(arr1(1, 1))
[B1].AddComment CStr(arr1(1, 2))
[C1].AddComment CStr(arr1(1, 3))
[D1].AddComment CStr(arr1(1, 4))
[A2].AddComment CStr(arr1(2, 1))
и тд..

Получается, что все-равно нужен какой-то перебор по всем ячейкам + нужно каждой ячейке задавать адрес.
Или я куда-то не в ту сторону смотрю.

Цитата
написал:
И Find никто не отменял...
По Find сейчас почитаю, плохо еще знаю VBA
Изменено: Fylhtqq - 05.12.2021 19:59:50
 
 
 
#7
05.12.2021 20:29:11
Код
Sub AddCommts()
  Dim c As Range, d As Range, txt$
  For Each c In [o1].CurrentRegion
    Set d = c.Offset(0, -14): txt = c
    If d.Comment Is Nothing Then d.AddComment txt Else d.Comment.Text txt
  Next
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#8
05.12.2021 20:30:11
Код
Sub AddComments()
    Dim arr As Variant, iRow As Long, iCol As Long

    With ActiveSheet
        arr = .Range("O1:R10").Value
        For iRow = 1 To UBound(arr)
            For iCol = 1 To UBound(arr, 2)
                With .Cells(iRow, iCol)
                    .ClearComments
                    .AddComment.Text Text:=CStr(arr(iRow, iCol))
                End With
            Next iCol
        Next iRow
    End With
End Sub
Изменено: New - 05.12.2021 20:38:10
 
 
 
#9
05.12.2021 22:32:03
Да, возможно насчет Find я и погорячился, но поскольку ТС горит желанием обойтись без цикла, то может что-то подобное подойдет:
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Dim r&, c&, t$, isect, rn As Range
        Set rn = ActiveSheet.Range("A1:D10")
        Set isect = Application.Intersect(rn, Target)
     If isect Is Nothing Then
        Exit Sub
     Else
        r = Target.Row
        c = Target.Column
        t = Cells(r, c + 14).Value
On Error GoTo Er1
        Cells(r, c).AddComment t
     End If
Er1:
End Sub
;)
А массивно мне у Игоря (#7) код понравился - коротко и эффективно :)
Изменено: _Igor_61 - 05.12.2021 22:39:13
 
 
 
Страницы: 1
Наверх