Kadet
|
"Нечто"... это мягко сказано. В общем - есть массив данных RaskroyType TRaskroy st(24) As Integer '//штук othod% '//отход End Type
Sub Main() Dim Raskroy(0) As TRaskroy ... ...
End Sub Необходимо зафиксировать первичные данные в массиве, а с копиями "поиграть", вернее применить к ним различные виды сортировки и т.п. Для этого я пытаюсь сделать копии первичного массива: Sub Main() Dim Raskroy(0) As TRaskroy ... 'Заносятся данные в массив Raskroy SetIntArray(Raskroy1, Raskroy) SetIntArray(Raskroy2, Raskroy) ...
End Sub
Sub SetIntArray(iArray() As Variant, v() As Variant) ' Dim X As TRaskroy Dim x, y Dim i As Long Dim j As Long j = UBound(v) RedimMyArray(iArray, j, New TRaskroy) For i = LBound(v) To UBound(v) iArray(i) = v(i) ' x=v(i) ' iArray(i)=x ' iArray(i).st=v(i).st ' iArray(i).othod=v(i).othod ' x=v(i).st ' y=v(i).othod ' iArray(i).st=x ' iArray(i).othod=y Next End Sub
В итоге, любые операции с одним из полученных массивов автоматически отражаются на все прочие массивы. Т.е. если я сортирую массив Raskroy2, то Raskroy и Raskroy1 тоже оказываются отсортированными. А если использовать посредническую переменную (X), то позиция (0) держится нормально, а все последующие позиции у массивов-копий получают данные последнего значения (Х). Т.е. - сплошные ссылки либо друг на друга, либо на посредническую переменную. Я даже пробовал брать простые переменные, типа Int и даже подмассив (st) переносить For-ом. Бесполезно. Сплошные ссылки. Об этой проблеме Питоньяк ещё на заре ОО говорил, и до сих пор воз и ныне там. а() = b() получаем в a() ссылку на b(), а не копию массива. Что делать? Как быть?
|
|
|
Записан
|
|
|
|
sokol92
|
Я для одномерных массивов написал такую функцию: ' Возвращает копию одномерного массива Function GetArrayCopy(Byval arr) Redim Preserve arr(lbound(arr) to ubound(arr)) GetArrayCopy=arr End Function
Sub TestArray() Dim arr1, arr2 arr1=Array(0,1) arr2=GetArrayCopy(arr1) arr2(1)=2 Print arr1(1), arr2(1) End Sub
По аналогии можно написать для двумерных (GetArray2Copy)
|
|
|
Записан
|
Владимир.
|
|
|
Kadet
|
Не могу представить как можно присвоить функции такой тип: Type TRaskroy st(24) As Integer '//штук othod% '//отход End Type
|
|
|
Записан
|
|
|
|
Kadet
|
Вижу единственный бредовый выход. При формировании первичного массива одновременно формировать и копии, а потом обрабатывать их.
|
|
|
Записан
|
|
|
|
eeigor
|
По аналогии можно написать для двумерных Sub Test2DArrayCopy() Dim aA(0 to 50, 0 to 40) Dim aB(0 to 50, 0 to 40)
aA(10, 10) = 80 aB = aA
ReDim Preserve aB(0 to 50, 0 to 40) 'or ReDim Preserve aA() aA(10, 10) = 50 MsgBox aA(10, 10) '50 MsgBox aB(10, 10) '80 End Sub UPD: У А.Питоньяка этот вопрос разобран. И он предупреждает: The statement "ReDim Preserve" on an Integer array assigned to a Variant array fails to preserve the data. Оператор «ReDim Preserve» для целочисленного массива, назначенного массиву Variant, не может сохранить данные. Dim a() As Integer 'declares a() as an Integer() a() = Array(0, 1, 2, 3, 4, 5, 6) 'assigns a Variant() to an Integer() ReDim Preserve a(1 To 3) As Integer 'массив будет стёрт To safely assign arrays while maintaining the correct data type, another method is required. Copy each element in the array individually. This also prevents two array variables from referencing the same array. https://bugs.documentfoundation.org/show_bug.cgi?id=134692https://bugs.documentfoundation.org/show_bug.cgi?id=134712https://www.openoffice.org/marketing/ooocon2004/presentations/thursday/Macro_D2.pdfСудя по содержанию постов выше, лучше всего на этот вопрос может ответить Mike Kaganski, гуру форума.
|
|
« Последнее редактирование: 14 Ноябрь 2020, 21:58 от eeigor »
|
Записан
|
Ubuntu 18.04 LTS • LO 7.1.1.2 Community
|
|
|
Kadet
|
Читал Питоньяка. Не работает. По крайней мере в моём случае. Кстати, SetIntArray это его функция. Я её и так, и эдак. И никак не получается. Сортировка любого из массивов сортирует все остальные.
|
|
|
Записан
|
|
|
|
eeigor
|
СправочноБыл такой автор ЧАРЛЬЗ Х. "ЧИП" ПИРСОН, и был (и есть!) классный сайт по Excel с большим количеством примеров VBA-кода. Трагически погиб в автокатастрофе. Кому интересно: https://www.legacy.com/obituaries/kansascity/obituary.aspx?n=charles-h-pearson-chip&pid=188846047Сайт был удалён из Сети, но потом, усилиями почитателей был возвращён обратно. Но сайт желательно скопировать на свой диск (на всякий случай). Смотрю на сайте: автор, как живой. Пусть так и будет... Вы сможете здесь найти что-н. для себя (с учётом особенностей LO Basic). Примеры процедур на VBA, обрабатывающих массивы, предложенные автором: AreDataTypesCompatible ChangeBoundsOfArray CombineTwoDArrays CompareArrays ConcatenateArrays CopyArray CopyArraySubSetToArray CopyNonNothingObjectsToArray DataTypeOfArray DeleteArrayElement ExpandArray FirstNonEmptyStringIndexInArray GetColumn GetRow InsertElementIntoArray IsArrayAllDefault IsArrayAllNumeric IsArrayAllocated IsArrayDynamic IsArrayEmpty IsArrayObjects IsArraySorted IsNumericDataType IsVariantArrayConsistent IsVariantArrayNumeric MoveEmptyStringsToEndOfArray NumberOfArrayDimensions NumElements ResetVariantArrayToDefaults ReverseArrayInPlace ReverseArrayOfObjectsInPlace SetObjectArrayToNothing SetVariableToDefault SwapArrayRows SwapArrayColumns TransposeArray VectorsToArray Даю ссылку: http://www.cpearson.com/excel/VBAArrays.htmUPD: http://www.cpearson.com/excel/PassingAndReturningArrays.htmVBA-код для аналогии ' Assigning An Array To An Array ' Unfortunately, VBA doesn't let you assign one array to another array, ' even if the size and data types match. For example, the following code will not work: Dim A(1 To 10) As Long Dim B(1 To 10) As Long ' Load B with data A = B
' You can, however, assign a Variant containing an array to another Variant. << ВОТ ЗДЕСЬ... ' The following code is perfectly legal:
Dim A As Variant Dim B As Variant Dim N As Long A = Array(11, 22, 33) B = A Debug.Print "IsArray(B) = " & CStr(IsArray(B)) For N = LBound(B) To UBound(B) Debug.Print B(N) Next N
' If you need to transfer the contents of one array to another, << ...ИЛИ ВОТ ЗДЕСЬ ' you must loop through the array element-by-element:
Dim A(1 To 3) As Long Dim B(0 To 5) As Long Dim NdxA As Long Dim NdxB As Long
A(1) = 11 A(2) = 22 A(3) = 33 NdxB = LBound(B) For NdxA = LBound(A) To UBound(A) If NdxB <= UBound(B) Then B(NdxB) = A(NdxA) Else Exit For End If NdxB = NdxB + 1 Next NdxA
For NdxB = LBound(B) To UBound(B) Debug.Print B(NdxB) Next NdxB
' The code above will transfer the contents of array A to array B. It does this successfully even if A and B ' have different LBounds, and will terminate the loop of the UBound of B is exceeded, ' which would be the case if A contains more elements than B. If A contains fewer elements than B, ' the unused elements of B will remain intact. If you want to ensure the B is "clean" before transferring the elements of A to it, ' use the Erase statement and, if B is a dynamic array, ReDim it back to its original size, as shown below:
Dim SaveLBound As Long Dim SaveUBound As Long SaveLBound = LBound(B) SaveUBound = UBound(B) Erase B If IsArrayDynamic(Arr:=B) = True Then ReDim B(SaveLBound, SaveUBound) End If Читайте, переводите, разбирайтесь... Я сам в LO Basic новичок...
|
|
« Последнее редактирование: 14 Ноябрь 2020, 21:49 от eeigor »
|
Записан
|
Ubuntu 18.04 LTS • LO 7.1.1.2 Community
|
|
|
eeigor
|
Было бы не плохо, если бы автор отписался нам о том, что и как, когда со всем этим разберётся...
|
|
|
Записан
|
Ubuntu 18.04 LTS • LO 7.1.1.2 Community
|
|
|
Kadet
|
Всё было бы хорошо, если бы я хоть в какой-то мере врубался в английский. Только гугл-перевод корявый.
Однако, спасибо! Попробую разобраться.
|
|
|
Записан
|
|
|
|
Kadet
|
Было бы не плохо, если бы автор отписался нам о том, что и как, когда со всем этим разберётся... Пока на скорую руку планирую пойти по простому, но глупому пути - формировать три массива одновременно, при формировании первичного. А потом по-отдельности их обрабатывать.
|
|
|
Записан
|
|
|
|
eeigor
|
Всё было бы хорошо, если бы я хоть в какой-то мере врубался в английский. XXI век... 2 скриншота: до и после. Поглядываем, понимая при этом, где перевод был излишним (сначала прочтём комментарии, а потом вернём всё взад).
|
|
« Последнее редактирование: 14 Ноябрь 2020, 21:55 от eeigor »
|
Записан
|
Ubuntu 18.04 LTS • LO 7.1.1.2 Community
|
|
|
eeigor
|
Я протестил вариант с массивом типа Variant, но в Basic код не сработал: копируется указатель, а не данные. С оператором ReDim Preserve aArray(lbound To ubound) сработало, но в ответе #4 (ссылки) говорилось о "подводных камнях" с этим оператором: нарушается индексация в разных копиях (?). НЕ ПРОВЕРЯЛ. НЕ СОРТИРОВАЛ. Sub TestArrayCopy() ' You can (?), however, assign a Variant containing an array to another Variant. ' The following code is perfectly legal:
Dim A(2) As Long 'A As Variant Dim B() As Long 'B As Variant
Dim i As Long
' A = Array(11, 22, 33) A(0) = 11: A(1) = 22: A(2) = 33 B = A: ReDim Preserve B(2)
Print "IsArray(B) = " & CStr(IsArray(B)) For i = LBound(B) To UBound(B) Print B(i) Next
A(0) = 10 B(0) = 100 Print "A(0) = "; A(0), "B(0) = "; B(0) 'returnes: A(0) = 10 B(0) = 100
Call BubbleSortList(B(), False) Print "A(0) = "; A(0), "B(0) = "; B(0) 'returnes: A(0) = 10 B(0) = 22 End Sub
' "Макросы и диалоги LibreOffice"/Tools/Strings 'EN This function bubble sorts an array of maximum 2 dimensions. ' The default sorting order is the first dimension. ' Only if sort2ndValue is True the second dimension is the relevant for the sorting order. 'RU Эта пузырьковая функция сортирует массив максимум из двух измерений. ' Порядок сортировки по умолчанию - первое измерение. ' Только если sort2ndValue имеет значение True, второе измерение имеет значение для порядка сортировки. Function BubbleSortList(ByVal SortList(), optional sort2ndValue As Boolean) Dim s As Integer Dim t As Integer Dim i As Integer Dim k As Integer Dim dimensions As Integer Dim sortvalue As Integer Dim DisplayDummy dimensions = 2
On Local Error Goto No2ndDim k = Ubound(SortList(), 2) No2ndDim: If Err <> 0 Then dimensions = 1 i = Ubound(SortList(),1) If ismissing(sort2ndValue) Then sortvalue = 0 Else sortvalue = 1 End If
For s = 1 to i - 1 For t = 0 to i-s Select Case dimensions Case 1 If SortList(t) > SortList(t + 1) Then DisplayDummy = SortList(t) SortList(t) = SortList(t + 1) SortList(t+1) = DisplayDummy End If Case 2 If SortList(t,sortvalue) > SortList(t + 1, sortvalue) Then For k = 0 to UBound(SortList(), 2) DisplayDummy = SortList(t, k) SortList(t, k) = SortList(t + 1, k) SortList(t + 1, k) = DisplayDummy Next k End If End Select Next t Next s BubbleSortList = SortList() End Function UPD: Насколько понял, штатной функции сортировки массива в Basic нет. Напишите свою, взяв за основу VBA-код того же автора: http://www.cpearson.com/excel/SortingArrays.aspxUPD2: Функция сортировки (пузырьковая) есть в приданной библиотеке. Вроде, сортирует... массив и трёх элементов. 
|
|
« Последнее редактирование: 14 Ноябрь 2020, 23:40 от eeigor »
|
Записан
|
Ubuntu 18.04 LTS • LO 7.1.1.2 Community
|
|
|
Kadet
|
Я протестил вариант с массивом типа Variant, но в Basic код не сработал: копируется указатель, а не данные. В том-то всё и дело. А у меня и тип ещё сложный, самодельный. В общем, сделал отдельное формирование трёх несвязанных одинаковых массивов. Всё как хотел заработало. И, думаю, пока на этом закончу. Может быть потом, по вдохновению попробую ещё поразбираться с этим вопросом.
|
|
|
Записан
|
|
|
|
Kadet
|
В общем, работа с массивами в StarBacis это полный ... (пушистый северный зверёк)... Я вообще перестаю понимать как тут всё работает. (Наверное пора пробовать питона, по настоятельным рекомендациям некоторых товарищей). Сделал демку для демонстрации некоторых приколов работы с массивами. В общем в двух словах. Есть всё те же сложно-составные массивы и над ними производится сортировка. И во время сортировки используется маленький макрос для перестановки позиций: Sub Swap1(ByRef v1, ByRef v2) Dim v v = v1 v1 = v2 v2 = v End Sub Всё было бы хорошо, но, почему-то, в итоге один элемент (всегда поиция 0) постоянно теряется. В общем именно этот элемент "недоперемещается". В какую-нибудь следующую позицию этот элемент из позиции "0" записывается, а вот оттуда в позицию "0" нужный элемент не переносится. И получается, что строка, которая должна стоять на позиции "0" вообще теряется, но вместо ней стоит "дубль" какой-нибудь другой позиции. Пример в "Лист2" - "неправильная сортировка". Обратите внимание - в "неправильной сортировке" позиция "0" и позиция "8" полностью идентичны, чего не может быть в данной работе и нет в первичных данных, а вот позиции "0", которая есть в "Правильная сортировка", вообще отсутствует, она просто потеряна. Чтобы получить правильную сортировку я переделал макрос так: Sub Swap(ByRef v1, ByRef v2) Dim X As TRaskroy X.othod=v1.othod X.st=v1.st v1.othod=v2.othod v1.st=v2.st v2.othod=X.othod v2.st=X.st End Sub И хотел вам это продемонстрировать в этой демке. Однако, в итоге получил вообще - нечто непонятное. "Лист2" - это данные, которые формирует моя база, которая использует те же макросы и с теми же данными и характеристиками. А вот "Лист1" формирует копия этих же макросов. Но там - какой-то ... (сев.звер)... творится. Что в правильной - бардак полный, позиция "1" вообще какая-то нулевая, а "неправильная сортировка" вообще не выдоится. Выводятся первоначальные данные, несортированные. Хотя в пошаговой прогонке, вроде бы всё сортируется в массиве "Raskroy2" сортировка производится, но выводятся совсем не те данные, которые значатся в "пошаговой"... В общем я вообще ничего не понимаю.
|
dem.ods (22.91 Кб - загружено 5 раз.)
|
« Последнее редактирование: 15 Ноябрь 2020, 11:56 от Kadet »
|
Записан
|
|
|
|
Kadet
|
В общем - аккуратнее с массивами и с их обработкой. Там что-то нечистое творится.
|
|
|
Записан
|
|
|
|
|