Переписать макрос под Calc

[W1ns]

Привет всем! Есть макрос, написанный под Excel, помогите, пожалуйста, переписать его под OpenOffice Calc.
Спасибо.

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

Sub Macro1()
Dim LastRow As Long, i As Long
   LastRow = Cells(Rows.Count, 1).End(xlUp).Row
   For i = LastRow To 6 Step -1
       If Cells(i - 1, 2) = Cells(i, 2) Then
           Cells(i - 1, 1) = Cells(i, 1) & ", " & Cells(i - 1, 1)
           Rows(i).Delete
       End If
   Next
End Sub

[bigor]

В libreoffice с

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

Option VBASupport 1 должен и этот макрос  отработать

[W1ns]

В libreoffice

извините не указал, я работаю с OpenOffice.org

[bigor]

Попробуйте тогда так:

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

Sub Macro1_1
Dim oSheets As Variant
Dim oSheet As Variant
Dim nCount As Long
Dim oEmptyRanges As Variant
Dim nLastRow As Long
oSheets = ThisComponent.getSheets()
oSheet = oSheets.getByIndex(0)
nCount = oSheet.getColumns().getByIndex(0).computeFunction(com.sun.star.sheet.GeneralFunction.COUNT)
For i = nCount To 5 Step -1
        If  oSheet.getCellByPosition(1,i - 1).string =  oSheet.getCellByPosition(1, i).string Then
             oSheet.getCellByPosition(0,i - 1).string =  oSheet.getCellByPosition(0,i).string & ", " &  oSheet.getCellByPosition(0,i - 1).string
             oSheet.getRows().removebyindex(i,1)
        End If
    Next

End Sub

[W1ns]

Bigor, спасибо работает. А можно сделать, чтобы новые значения подставлялись не в начало, а конец после запятой?

[bigor]

можно сделать, чтобы новые значения подставлялись не в начало, а конец после запятой?

можно, замените строку после then

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

oSheet.getCellByPosition(0,i - 1).string =  oSheet.getCellByPosition(0,i-1).string & ", " &  oSheet.getCellByPosition(0,i).string


ps и это

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

Dim oEmptyRanges As Variant
Dim nLastRow As Long
можно удалить.

[W1ns]

Спасибо большое, теперь все работает хорошо)