Доброго времени суток, уважаемые форумчане. Долгое время дня и ночи бьюсь, не могу решить, как сначала думал посильную задачу. Но оказался бессилен со своим багажом знаний. Есть переменная 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]
Доброго времени суток, уважаемые форумчане. Долгое время дня и ночи бьюсь, не могу решить, как сначала думал посильную задачу. Но оказался бессилен со своим багажом знаний. Есть переменная 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
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