qwertyuiopa
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Приветствую.
Подскажите, есть макрос для OpenOffice. В Excel - не работает, Ругается на синтаксические ошибки, в строке: ParseMap (Head, Col, NumRows).
Код:
Sub Categorize()
Dim Cursor As Object, Map As Object, Range As Object
Dim NumColumns As Long, Col As Long, NumRows As Long
Dim Head As String
Map = ThisComponent.Sheets.getByName("Карта")
Cursor = Map.createCursor
Cursor.gotoEndOfUsedArea (True)
NumColumns = Cursor.Columns.Count
For Col = 0 To NumColumns - 1 Step 2
Head = Map.getCellByPosition(Col, 0).String
If Head <> "" Then
NumRows = LastRowWithData(Col) + 1
ParseMap (Head, Col, NumRows)
End If
Next Col
MsgBox "Обработка ядра завершена.)"
End Sub
Sub ParseMap(ByVal Head As String, ByVal Col As Long, ByVal NumMarks As Long)
Dim Names(1 To NumMarks) As String, Keys(1 To NumMarks) As String
Dim Core As Object, Map As Object, Cell As Object, Source As Object, Cursor As Object
Dim I, J, NumRows, CellIndex
CellIndex = GetCellByName(Head)
Core = ThisComponent.Sheets.getByName("Ядро")
Map = ThisComponent.Sheets.getByName("Карта")
For I = 1 To NumMarks
Keys(I) = Map.getCellByPosition(Col, I - 1).String
Names(I) = Map.getCellByPosition(Col + 1, I - 1).String
Next I
Cursor = Core.createCursor
Cursor.gotoEndOfUsedArea (True)
NumRows = Cursor.Rows.Count
For I = 1 To NumRows
Source = Core.getCellByPosition(0, I)
Cell = Core.getCellByPosition(CellIndex, I)
For J = 1 To NumMarks
If InStr(LCase(Source.String), LCase(Keys(J))) > 0 Then
Cell.String = Names(J)
End If
Next J
Next I
End Sub
Function GetCellByName(Head As String)
Dim Core As Object, Cursor As Object
Dim J
Core = ThisComponent.Sheets.getByName("Ядро")
Cursor = Core.createCursor
Cursor.gotoEndOfUsedArea (True)
NumColumns = Cursor.Columns.Count
For J = 1 To NumColumns
If Core.getCellByPosition(J - 1, 0).String = Head Then
GetCellByName = J - 1
Exit Function
End If
Next
Core.Columns.insertByIndex(1, 1)
Core.getCellByPosition(1, 0).String = Head
GetCellByName = 1
End Function
Function LastRowWithData(ColumnIndex As Long) As Long
Dim Cursor As Object, Range As Object, Map As Object
Dim LastRowOfUsedArea As Long, R As Long
Dim RangeData
Map = ThisComponent.Sheets.getByName("Карта")
Cursor = Map.createCursor
Cursor.gotoEndOfUsedArea (False)
LastRowOfUsedArea = Cursor.RangeAddress.EndRow
Range = Map.getCellRangeByPosition(ColumnIndex, 0, ColumnIndex, LastRowOfUsedArea)
Cursor = Map.createCursorByRange(Range)
RangeData = Cursor.getDataArray
For R = UBound(RangeData) To LBound(RangeData) Step -1
If RangeData(R)(0) <> "" Then
LastRowWithData = R
Exit Function
End If
Next
End Function
|
Подскажите пожалуйста, как поправить? |
Всего записей: 24 | Зарегистр. 13-02-2007 | Отправлено: 13:48 31-05-2013 | Исправлено: qwertyuiopa, 13:49 31-05-2013 |
|
