Добрый день. В приведенной функции формируется массив на вход которой поступает область листа, для заполнения ListBox
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(1ToUBound(a), 1ToUBound(aColumns) + 1)
For i = 1ToUBound(a) If a(i, 7) = ""Then Else For j = LBound(aColumns) ToUBound(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)) EndIf Next
num = num + 1 EndIf Next
'ReDim Preserve e(1 To num, 1 To UBound(aColumns) + 1)
GetTableBodyRange = e
EndFunction
Однако размер массива соответствует количеству строк области, необходимо сделать размер соответствующий количеству данных, в моем примере это num
Такое решение выдает ошибку, прошу прощение за туфтологию
Добрый день. В приведенной функции формируется массив на вход которой поступает область листа, для заполнения ListBox
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(1ToUBound(a), 1ToUBound(aColumns) + 1)
For i = 1ToUBound(a) If a(i, 7) = ""Then Else For j = LBound(aColumns) ToUBound(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)) EndIf Next
num = num + 1 EndIf Next
'ReDim Preserve e(1 To num, 1 To UBound(aColumns) + 1)
GetTableBodyRange = e
EndFunction
Однако размер массива соответствует количеству строк области, необходимо сделать размер соответствующий количеству данных, в моем примере это num
А справку читали по 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?
Function GetTableBodyRange(aColumns, a) Dim e(), i, j, num, cnt For i = 1ToUBound(a) 'проверка строки на пустоту
cnt = 0 For j = LBound(aColumns) ToUBound(aColumns) IfVarType(a(i, aColumns(j))) = vbEmpty Then
cnt = cnt + 1 Else ExitFor EndIf Next j 'добавление непустой строки - столбцом в массив, развернутый на 90 градусов If cnt < UBound(aColumns) + 1Then
num = num + 1 'увеличиваем вторую размерность развернутого массива 'т.е. добавляем столбец, который в конце концов станет строкой ReDim Preserve e(1ToUBound(aColumns) + 1, 1To num) For j = LBound(aColumns) ToUBound(aColumns) IfVarType(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)) EndIf Next j EndIf Next i 'обратный разворот массива на 90 градусов - столбцы становятся строками
GetTableBodyRange = WorksheetFunction.Transpose(e) EndFunction
Тестовая процедура - в модуль листа, на котором ListBox1:
Sub test_() Dim a
a = Sheets("List").ListObjects("tblOrder").DataBodyRange.Value
Me.ListBox1.List = GetTableBodyRange(Array(1, 4, 2, 3), a) EndSub
Sashagor1982, с какими значениями параметров aColumns и a собираетесь вызывать свою (из этой темы) функцию GetTableBodyRange применительно к файлу из сообщения № 1?
Function GetTableBodyRange(aColumns, a) Dim e(), i, j, num, cnt For i = 1ToUBound(a) 'проверка строки на пустоту
cnt = 0 For j = LBound(aColumns) ToUBound(aColumns) IfVarType(a(i, aColumns(j))) = vbEmpty Then
cnt = cnt + 1 Else ExitFor EndIf Next j 'добавление непустой строки - столбцом в массив, развернутый на 90 градусов If cnt < UBound(aColumns) + 1Then
num = num + 1 'увеличиваем вторую размерность развернутого массива 'т.е. добавляем столбец, который в конце концов станет строкой ReDim Preserve e(1ToUBound(aColumns) + 1, 1To num) For j = LBound(aColumns) ToUBound(aColumns) IfVarType(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)) EndIf Next j EndIf Next i 'обратный разворот массива на 90 градусов - столбцы становятся строками
GetTableBodyRange = WorksheetFunction.Transpose(e) EndFunction
Тестовая процедура - в модуль листа, на котором ListBox1:
Sub test_() Dim a
a = Sheets("List").ListObjects("tblOrder").DataBodyRange.Value
Me.ListBox1.List = GetTableBodyRange(Array(1, 4, 2, 3), a) EndSub