Добрый день. В приведенной функции формируется массив на вход которой поступает область листа, для заполнения ListBox
[vba]
Код
Function GetTableBodyRange(aColumns, a) 'Dim e(1 To UBound(a), 1 To UBound(aColumns) + 1) 'Dim a Dim i, j, num num = 1 ReDim e(1 To UBound(a), 1 To UBound(aColumns) + 1)
For i = 1 To UBound(a) If a(i, 7) = "" Then Else For j = LBound(aColumns) To UBound(aColumns) If (j = 4) Then e(num, j + 1) = Format(a(i, aColumns(j)), "dd.mm.yyyy") Else e(num, j + 1) = a(i, aColumns(j)) End If Next num = num + 1 End If Next
'ReDim Preserve e(1 To num, 1 To UBound(aColumns) + 1) GetTableBodyRange = e
End Function
[/vba] Однако размер массива соответствует количеству строк области, необходимо сделать размер соответствующий количеству данных, в моем примере это num [vba]
Код
ReDim Preserve e(1 To num, 1 To UBound(aColumns) + 1)
[/vba] Такое решение выдает ошибку, прошу прощение за туфтологию
Добрый день. В приведенной функции формируется массив на вход которой поступает область листа, для заполнения ListBox
[vba]
Код
Function GetTableBodyRange(aColumns, a) 'Dim e(1 To UBound(a), 1 To UBound(aColumns) + 1) 'Dim a Dim i, j, num num = 1 ReDim e(1 To UBound(a), 1 To UBound(aColumns) + 1)
For i = 1 To UBound(a) If a(i, 7) = "" Then Else For j = LBound(aColumns) To UBound(aColumns) If (j = 4) Then e(num, j + 1) = Format(a(i, aColumns(j)), "dd.mm.yyyy") Else e(num, j + 1) = a(i, aColumns(j)) End If Next num = num + 1 End If Next
'ReDim Preserve e(1 To num, 1 To UBound(aColumns) + 1) GetTableBodyRange = e
End Function
[/vba] Однако размер массива соответствует количеству строк области, необходимо сделать размер соответствующий количеству данных, в моем примере это num [vba]
Код
ReDim Preserve e(1 To num, 1 To UBound(aColumns) + 1)
[/vba] Такое решение выдает ошибку, прошу прощение за туфтологиюSashagor1982
А справку читали по ReDim Preserve? Попробуйте, там русским по белому написано, что можно менять только последнюю размерность массива. А Вы меняете первую
А справку читали по ReDim Preserve? Попробуйте, там русским по белому написано, что можно менять только последнюю размерность массива. А Вы меняете первую_Boroda_
А если надо поменять первую, то, видимо, придётся сначала сформировать массив, повернутый на 90 градусов. С поставленными наоборот размерностями (т.е. ожидаемые на выходе строки при этом временно станут столбцами, а столбцы - строками). А после всех манипуляций массив разворачивается обратно с помощью функции WorksheetFunction.Transpose.
Sashagor1982, и, кстати, Вам же, вроде, больше года назад уже помогали в похожем вопросе: Заполнение ListBox значениями из умной таблицы Так там всё работает. Надо только Sub test поместить в модуль листа и проследить, чтобы на этом листе был список с именем ListBox1 (из тулбара "Элементы AxtiveX").
А если надо поменять первую, то, видимо, придётся сначала сформировать массив, повернутый на 90 градусов. С поставленными наоборот размерностями (т.е. ожидаемые на выходе строки при этом временно станут столбцами, а столбцы - строками). А после всех манипуляций массив разворачивается обратно с помощью функции WorksheetFunction.Transpose.
Sashagor1982, и, кстати, Вам же, вроде, больше года назад уже помогали в похожем вопросе: Заполнение ListBox значениями из умной таблицы Так там всё работает. Надо только Sub test поместить в модуль листа и проследить, чтобы на этом листе был список с именем ListBox1 (из тулбара "Элементы AxtiveX").Gustav
Sashagor1982, с какими значениями параметров aColumns и a собираетесь вызывать свою (из этой темы) функцию GetTableBodyRange применительно к файлу из сообщения № 1?
[p.s.]под вечерний телевизор разродился - замастырил на основе функции R_Dmitry из старой темы:[/p.s.] [vba]
Код
Function GetTableBodyRange(aColumns, a) Dim e(), i, j, num, cnt For i = 1 To UBound(a) 'проверка строки на пустоту cnt = 0 For j = LBound(aColumns) To UBound(aColumns) If VarType(a(i, aColumns(j))) = vbEmpty Then cnt = cnt + 1 Else Exit For End If Next j 'добавление непустой строки - столбцом в массив, развернутый на 90 градусов If cnt < UBound(aColumns) + 1 Then num = num + 1 'увеличиваем вторую размерность развернутого массива 'т.е. добавляем столбец, который в конце концов станет строкой ReDim Preserve e(1 To UBound(aColumns) + 1, 1 To num) For j = LBound(aColumns) To UBound(aColumns) If VarType(a(i, aColumns(j))) = vbDate Then 'преобразование дат в привычный формат e(j + 1, num) = Format(a(i, aColumns(j)), "dd.mm.yyyy") Else e(j + 1, num) = a(i, aColumns(j)) End If Next j End If Next i 'обратный разворот массива на 90 градусов - столбцы становятся строками GetTableBodyRange = WorksheetFunction.Transpose(e) End Function
[/vba]
Тестовая процедура - в модуль листа, на котором ListBox1: [vba]
Код
Sub test_() Dim a a = Sheets("List").ListObjects("tblOrder").DataBodyRange.Value Me.ListBox1.List = GetTableBodyRange(Array(1, 4, 2, 3), a) End Sub
[/vba]
Sashagor1982, с какими значениями параметров aColumns и a собираетесь вызывать свою (из этой темы) функцию GetTableBodyRange применительно к файлу из сообщения № 1?
[p.s.]под вечерний телевизор разродился - замастырил на основе функции R_Dmitry из старой темы:[/p.s.] [vba]
Код
Function GetTableBodyRange(aColumns, a) Dim e(), i, j, num, cnt For i = 1 To UBound(a) 'проверка строки на пустоту cnt = 0 For j = LBound(aColumns) To UBound(aColumns) If VarType(a(i, aColumns(j))) = vbEmpty Then cnt = cnt + 1 Else Exit For End If Next j 'добавление непустой строки - столбцом в массив, развернутый на 90 градусов If cnt < UBound(aColumns) + 1 Then num = num + 1 'увеличиваем вторую размерность развернутого массива 'т.е. добавляем столбец, который в конце концов станет строкой ReDim Preserve e(1 To UBound(aColumns) + 1, 1 To num) For j = LBound(aColumns) To UBound(aColumns) If VarType(a(i, aColumns(j))) = vbDate Then 'преобразование дат в привычный формат e(j + 1, num) = Format(a(i, aColumns(j)), "dd.mm.yyyy") Else e(j + 1, num) = a(i, aColumns(j)) End If Next j End If Next i 'обратный разворот массива на 90 градусов - столбцы становятся строками GetTableBodyRange = WorksheetFunction.Transpose(e) End Function
[/vba]
Тестовая процедура - в модуль листа, на котором ListBox1: [vba]
Код
Sub test_() Dim a a = Sheets("List").ListObjects("tblOrder").DataBodyRange.Value Me.ListBox1.List = GetTableBodyRange(Array(1, 4, 2, 3), a) End Sub