макрос Сортировка по алфавиту (Calc)

[sokol92]

Напишу, когда появится время.

[timal1234]

Напишу, когда появится время.

Хорошо, буду ждать.

не совсем... сначала должны идти английские наименования

записываем массив в диапазон Calc на каком-нибудь скрытом листе, сортируем в Calc, забираем результат.

и ещё тогда вопрос, как сделать скрытый лист через макрос или можно просто вручную создать лист и скрыть его?

[sokol92]

Сделал первую версию. Потестируйте, пожалуйста.
Пример вызова - TestSort.
Пока не реализована сортировка букв кириллицы после букв латинского алфавита. Добавлю позднее.

Код Выделить Развернуть

' lang:ru
' Натуральная сортировка массива.
' Параметры:
' arr    - одномерный массив для сортировки.
' oSheet - вспомогательный лист Calc на котором производится сортировка.
'
' Возвращает отсортированный в соответствии с правилами "Natural sort" массив.
' При сортировке даты сортируются как соответствующие числа, false/true как 0/1,
' пустые значения как текстовые строки длины 0.
' Максимальное число элементов массива определяется как число строк листа Calc.
Function SortNatural(ByVal arr, Optional ByVal oSheet As Object)
  Dim i As Long, i1 As Long, i2 As Long, bTemp As Boolean, aData, t As Long, v, res
  Dim oDoc As Object, oRange as Object, props1(0) As New com.sun.star.beans.PropertyValue
  Dim oDisp as Object, props(4) as new com.sun.star.beans.PropertyValue
 
  If IsMissing(oSheet) Then oSheet=Nothing
  i1=LBound(arr)
  i2=UBound(arr)
  If i2<i1 Then  ' пустой массив
    SortNatural=arr
    Exit Function
  End If 
 
  ReDim aData(i2-i1)
  For i=i1 To i2
    v=arr(i)
    t=VarType(v)
    If t=V_DATE Or t=V_CURRENCY Then
      v=CDbl(v)
    ElseIf t=11 Then  ' Boolean
      v=Iif(v, 1, 0)
    ElseIf t=V_EMPTY Or t=V_NULL Then
      v=""
    End If   
   
    aData(i-i1)=Array(v, i)
  Next i
 
  If oSheet Is Nothing Then
    props1(0).Name="Hidden"
    props1(0).Value=True  ' ???
    oDoc = StarDesktop.LoadComponentFromUrl("private:factory/scalc","_default",0, props1)
    oSheet=oDoc.Sheets(0)
    bTemp=True
  Else 
    oDoc=oSheet.DrawPage.Forms.Parent
  End If
 
  oRange=oSheet.GetCellRangebyPosition(0, 0, 1, i2-i1)
  oRange.setDataArray aData
  oDoc.CurrentController.Select oRange
 
  props(0).Name = "ByRows"
  props(0).Value = true
  props(1).Name = "HasHeader"
  props(1).Value = false
  props(2).Name = "NaturalSort"
  props(2).Value = true
  props(3).Name = "Col1"
  props(3).Value = 1
  props(4).Name = "Ascending1"
  props(4).Value = true

  oDisp = createUnoService("com.sun.star.frame.DispatchHelper")
  oDisp.executeDispatch(oDoc.CurrentController.Frame, ".uno:DataSort", "", 0, props())
 
  aData=oRange.DataArray  ' отсортированный диапазон
 
  ReDim res(i1 To i2)
  For i=i1 To i2
    res(i)=arr(aData(i-i1)(1))
  Next i
  SortNatural=res
 
  If bTemp Then oDoc.Close True 
End Function

Sub TestSort
  Dim arr, res
  arr=Array("MDR-60-12", "MDR-60-12", "MDR-60-7", "MDR-100-5", "Кириллица")
  res=SortNatural(arr)
End Sub