Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

18 Октябрь 2019, 07:14 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Часто задаваемые вопросы по LibreOffice и Apache OpenOffice.org
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1   Вниз
  Печать  
Автор Тема: Помощь с макросом  (Прочитано 1446 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Alder
Участник
**
Offline Offline

Сообщений: 24


« Стартовое сообщение: 7 Апрель 2016, 12:26 »

Есть макрос.
Его задача просматривать большое кол-во числовых данных (в формате 0,00) и показывать что не является повтором.
Но появилась проблема, некоторые числа идут с погрешностью +/- 0,003.
Я бы хотел добавить строку:
oSelection = Round(oSearchResults.getByIndex(i),2)
Но oSelection у меня Variant.

Есть ли способ определения типа переменой и редактирование его?

Сам код, украл где-то:
Код:
Sub colorDbl
Dim oCurrentSelection As Variant
Dim oActiveSheet As Variant
Dim oSelection As Integer
Dim oDataArray As Variant
Dim oData As Variant
Dim oElement As Variant
Dim aCounter As Variant
Dim i&, j&, k&
Dim oSearchDescriptor As Variant
Dim oSearchResults As Variant
Dim sResult As String
Dim nCellBackColor As Long
oCurrentSelection = ThisComponent.getCurrentSelection()
If oCurrentSelection.supportsService("com.sun.star.table.Cell") Then ' Выделена только одна ячейка (то есть - ничего)
oActiveSheet = ThisComponent.getCurrentController().getActiveSheet()
oCurrentSelection = oActiveSheet.createCursor()
oCurrentSelection.gotoEndOfUsedArea(True)
EndIf
REM Чтобы не перебирать кучу пустых ячеек, выберем из выделения только непустые
oSearchDescriptor = oCurrentSelection.createSearchDescriptor()
oSearchDescriptor.SearchType = 1 ' Поиск по значениям
oSearchDescriptor.SearchRegularExpression = True
oSearchDescriptor.setSearchString(".+")
oSearchResults = oCurrentSelection.findAll(oSearchDescriptor)
aCounter = Array()
If IsEmpty(oSearchResults) Or IsNull(oSearchResults) Then
MsgBox("В указанном выделении нет ячеек для поиска дублей", 64, "Измените или снимите выделение")
Else
For i=0 To oSearchResults.getCount()-1
oSelection = oSearchResults.getByIndex(i)
oDataArray = oSelection.getDataArray()
For j = LBound(oDataArray) To UBound(oDataArray)
oData = oDataArray(j)
For k = LBound(oData) To UBound(oData)
oElement = oData(k)
If oElement <> "" Then CountOrAdd(oElement, aCounter)
Next k
Next j
Next i
REM Информация собрана, для всех повторов - раскраска
oSearchDescriptor = oCurrentSelection.createSearchDescriptor()
oSearchDescriptor.SearchType = 1 ' Поиск по значениям
oSearchDescriptor.SearchWords = True
j = 0
k = 0
sResult = ""
For i=LBound(aCounter) To UBound(aCounter)
oData = aCounter(i)
oSearchDescriptor.setSearchString(oData(0))
oSearchResults = oCurrentSelection.findAll(oSearchDescriptor)
If oData(1) > 1 Then
j = j + 1
If sResult <> "" Then sResult = sResult +", "
nCellBackColor = RGB(180,255,180)
sResult = sResult + oData(0)
k = k + oSearchResults.getCount()
Else
nCellBackColor = RGB(255,180,180)
EndIf
oSearchResults.CellBackColor = nCellBackColor
Next i
If j = 0 Then
MsgBox("В указанном выделении дублей не обнаружено", 64, "Без результата")
Else
EndIf
EndIf
End Sub

Private Sub CountOrAdd(key, aData)
Dim l&, r&, m&, N&, i&
l=LBound(aData)
r=UBound(aData)+1
N=r
While (l<r)
m=l+Int((r-l)/2)
If aData(m)(0)<key Then
l=m+1
Else
r=m
EndIf
Wend
If r=N Then
ReDim Preserve aData(0 To N)
aData(N) = Array(key,1)
ElseIf  aData(r)(0)=key Then
aData(r)(1)=aData(r)(1)+1
Else
ReDim Preserve aData(0 To N)
For i = N-1 To r Step -1
aData(i+1)=aData(i)
Next i
aData(r) = Array(key,1)
EndIf
End Sub

LO 4.3.5
« Последнее редактирование: 7 Апрель 2016, 12:28 от Alder » Записан
Страниц: 1   Вверх
  Печать  
 
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2009, Simple Machines Valid XHTML 1.0! Valid CSS!