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

Вход

Регистрация

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

 

= Мир MS Excel/Присвоение переменной массива значений из цикла For Each - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Присвоение переменной массива значений из цикла For Each
Markovich Дата: Суббота, 20.01.2024, 22:48 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 50
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Доброго времени суток, уважаемые форумчане. Долгое время дня и ночи бьюсь, не могу решить, как сначала думал посильную задачу. Но оказался бессилен со своим багажом знаний. Есть переменная multirng, в которой несвязанные диапазоны выделенных строк. Для дальнейшей обработки данных мне нужно номера первой и последней строки каждого выделенного диапазона загнать в переменные z(i) и y(i). Если это возможно, то еще в идеале, используя существующие циклы, нужно выстроить эти диапазоны по возрастанию (т.к. выделяться они могут хаотично, а на выходе строй по возрастанию принципиально). Это было бы вообще то что надо. Освоил способ "сначала загнать адреса списком в текстовую строку, а затем вытянуть в переменные массива, но он длинный и, как мне кажется неразумный. Внизу кривой эскиз. С таким вложенным циклом никакой нормальной нумерации z(i) и y(i) конечно же нет, но это как я представлял картину, крутил, менял местами в поисках. Помогите пожалуйста найти решение.

[vba]
Код

Sub test()
Dim element As Range, multirng As Range, nrw As Range
Dim str As Byte, i As Byte, z() As Integer, y() As Integer
Dim s As String
For Each element In Selection
str = 1 + str
If multirng Is Nothing Then
Set multirng = Rows(element.Row)
Else
Set multirng = Union(multirng, Rows(element.Row))
End If
Next
' текстовая строка для передачи в другие книги
For Each nrw In multirng.Areas
s = s & "," & nrw.EntireRow.Address(0, 0)
Next
' значения из цикла загнать по-возрастанию в переменные массива
ReDim z(1 To multirng.Areas.Count)
ReDim y(1 To multirng.Areas.Count)
For i = 1 To multirng.Areas.Count
For Each nrw In multirng.Areas
z(i) = nrw.Rows(1).Row
y(i) = nrw.Rows(nrw.Rows.Count).Row
Next
Next
End Sub
[/vba]


Сообщение отредактировал Markovich - Суббота, 20.01.2024, 22:50
 
Ответить
СообщениеДоброго времени суток, уважаемые форумчане. Долгое время дня и ночи бьюсь, не могу решить, как сначала думал посильную задачу. Но оказался бессилен со своим багажом знаний. Есть переменная multirng, в которой несвязанные диапазоны выделенных строк. Для дальнейшей обработки данных мне нужно номера первой и последней строки каждого выделенного диапазона загнать в переменные z(i) и y(i). Если это возможно, то еще в идеале, используя существующие циклы, нужно выстроить эти диапазоны по возрастанию (т.к. выделяться они могут хаотично, а на выходе строй по возрастанию принципиально). Это было бы вообще то что надо. Освоил способ "сначала загнать адреса списком в текстовую строку, а затем вытянуть в переменные массива, но он длинный и, как мне кажется неразумный. Внизу кривой эскиз. С таким вложенным циклом никакой нормальной нумерации z(i) и y(i) конечно же нет, но это как я представлял картину, крутил, менял местами в поисках. Помогите пожалуйста найти решение.

[vba]
Код

Sub test()
Dim element As Range, multirng As Range, nrw As Range
Dim str As Byte, i As Byte, z() As Integer, y() As Integer
Dim s As String
For Each element In Selection
str = 1 + str
If multirng Is Nothing Then
Set multirng = Rows(element.Row)
Else
Set multirng = Union(multirng, Rows(element.Row))
End If
Next
' текстовая строка для передачи в другие книги
For Each nrw In multirng.Areas
s = s & "," & nrw.EntireRow.Address(0, 0)
Next
' значения из цикла загнать по-возрастанию в переменные массива
ReDim z(1 To multirng.Areas.Count)
ReDim y(1 To multirng.Areas.Count)
For i = 1 To multirng.Areas.Count
For Each nrw In multirng.Areas
z(i) = nrw.Rows(1).Row
y(i) = nrw.Rows(nrw.Rows.Count).Row
Next
Next
End Sub
[/vba]

Автор - Markovich
Дата добавления - 20.01.2024 в 22:48
doober Дата: Суббота, 20.01.2024, 23:54 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 947
Репутация: 323 ±
Замечаний: 0% ±

Excel 2010
Доброго.[vba]
Код
Sub test()
    Dim z&(), y()
    Dim i&
    ReDim z(1 To Selection.Areas.Count, 1 To 2)
    i = 0
    For Each element In Selection.Areas
        i = i + 1
        y = element.Value
        z(i, 1) = element.Row
        z(i, 2) = element.Row + UBound(y) - 1
    Next
    BubbleSort z

End Sub
Sub BubbleSort(ByRef List)
    Dim First As Integer, Last As Integer
    Dim i As Integer, j As Integer
    Dim Temp&
    Dim Temp1&
    First = LBound(List)
    Last = UBound(List)
    For i = First To Last - 1
        For j = i + 1 To Last
            If List(i, 1) > List(j, 1) Then
                Temp = List(j, 1)
                Temp1 = List(j, 2)
                List(j, 1) = List(i, 1)
                List(j, 2) = List(i, 2)
                List(i, 1) = Temp
                List(i, 2) = Temp1
            End If
        Next j
    Next i
End Sub
[/vba]


 
Ответить
СообщениеДоброго.[vba]
Код
Sub test()
    Dim z&(), y()
    Dim i&
    ReDim z(1 To Selection.Areas.Count, 1 To 2)
    i = 0
    For Each element In Selection.Areas
        i = i + 1
        y = element.Value
        z(i, 1) = element.Row
        z(i, 2) = element.Row + UBound(y) - 1
    Next
    BubbleSort z

End Sub
Sub BubbleSort(ByRef List)
    Dim First As Integer, Last As Integer
    Dim i As Integer, j As Integer
    Dim Temp&
    Dim Temp1&
    First = LBound(List)
    Last = UBound(List)
    For i = First To Last - 1
        For j = i + 1 To Last
            If List(i, 1) > List(j, 1) Then
                Temp = List(j, 1)
                Temp1 = List(j, 2)
                List(j, 1) = List(i, 1)
                List(j, 2) = List(i, 2)
                List(i, 1) = Temp
                List(i, 2) = Temp1
            End If
        Next j
    Next i
End Sub
[/vba]

Автор - doober
Дата добавления - 20.01.2024 в 23:54
Markovich Дата: Воскресенье, 21.01.2024, 13:06 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 50
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
doober, огромное Вам спасибо. Весь мозг сломал как "i" прикрутить, а решение оказалось настолько очевидным.
 
Ответить
Сообщениеdoober, огромное Вам спасибо. Весь мозг сломал как "i" прикрутить, а решение оказалось настолько очевидным.

Автор - Markovich
Дата добавления - 21.01.2024 в 13:06
  • Страница 1 из 1
  • 1
Поиск:

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