Удалить дубликаты

[bigor]

А почему в списке локалей нет великого и могучего?

[mikekaganski]

Что-то не клеится...

Пожалуйста, приложите саму табличку, чтобы посмотреть, что не так

А почему в списке локалей нет великого и могучего?

Потому что локализацией оригинального кода мы не занимались, что было - то осталось...

[bigor]

Вот пример

Порядок действий:

1. Удаляю 1 в d3
2. Становлюсь в d8
3. Жму кнопку запуска расширения
     оно показывает 2 выделенных столбца
4. Жму Ok
5. Выскакивает сообщение как у rami
6. в d3 восстанавливается 1

[mikekaganski]

@Bigor: спасибо!

[kompilainenn]

Выкладываю версию 1.0.2 расширения:
1. Обрабатывается ситуация, если выделен весь лист до запуска расширения -> расширение делать ничего не будет
2. Фикс траблы по описанию Bigor'a
3. Исправлено появление лишних меню Данные во всех модулях, вместо только лишь Кальк

[bigor]

По 1.0.2

1.Если предварительно выделить  столбцы с данными и затем подтвердить их в расширении, то процесс затягивается за счет обработки пустых ячеек

2.И еще интересная ситуация. Если в приложенном файле стать в k1 запустить расширение по столбцам k, l то находит и удаляет 7 дубликатов. Если стать в f1 запустить расширение выбрать столбцы f,g то находит и удаляет 19 дубликатов

[mikekaganski]

1 - так и задумано. Он автоопределяет *только* если ничего не выделено, иначе обрабатывает выделение пользователя независимо от содержимого (пользователю виднее).

[kompilainenn]

Доступна версия 1.0.4
1. Обработка выделения всего листа сделана более умной, расширение будет обрабатывать только диапазон, который содержит реальные данные
2. Более быстрый старт самого диалога

[rami]

А почему в списке локалей нет великого и могучего?

Потому что локализацией оригинального кода мы не занимались, что было - то осталось...

В начале темы мы обсуждали:

Расширение имеет смысл делать если оно будет отличаться от существующих инструментов дополнительным востребованным функционалом.

оно будет отличаться как минимум более простым применением, чем настройка фильтра, в большинстве случаев

Без локализации удобство использования будет сомнительным.

kompilainenn, ты можешь сделать локализацию сам, это не сложно, mikekaganski об этом даже не узнает (это не затрагивает код обработки данных, да и язык офиса у mikekaganski кажется английский)

Нужно будет добавить кое-какой код, часть кода удалить, часть изменить, а с учётом того, что русский перевод кое-где не поместится в надписях, прийдётся увеличить соответствующие элементы в диалоге. Готов? Скажу что и где сделать.

[kompilainenn]

Скажу что и где сделать.

ты говори без прелюдий, я готов или не я готов. Вдруг найдется тот, кто поготовее меня

[rami]

Без прелюдий:
Модуль Locale

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

REM  *****  BASIC  *****
Dim stringLists() As String

Function getLanguage
GlobalScope.BasicLibraries.LoadLibrary("Tools")
getLanguage = GetStarOfficeLocale().language + "_" + GetStarOfficeLocale().country
End Function

Function getText(index)
getText = stringLists(index)
End Function

Sub InitLanguage
Select Case getLanguage
Case "ru_"
load_ru
Case "zh_CN"
load_zh_CN
Case "zh_TW"
load_zh_TW
Case Else
load_en
End Select
End Sub

Sub load_en
stringLists() = array( _
"Do not support multiselection", _
"Please select a range", _
"Column ", _
"Select ~All", _
"~Selection includes title", _
"~Please select the duplicate columns (Press Ctrl to multiselect):", _
"~OK", _
"~Cancel", _
"Progress", _
"Finished in ", _
" seconds.", _
"We found and deleted ", _
" duplicated values.", _
"Now we have only ", _
" unique values.", _
"No duplicates found.", _
"Cancelled. ", _
"An error occurred! ", _
"The changes will now be undone.", _
"No changes have been made.")
End Sub

Sub load_ru
stringLists() = array( _
"Не поддерживает множественный выбор", _
"Пожалуйста, выберите диапазон", _
"Столбец ", _
"Выбрать всё", _
"Выбор включает заголовок", _
"Пожалуйста, выберите столбцы с дубликатами (нажмите Ctrl для множественного выбора):", _
"OK", _
"Отменить", _
"Прогресс", _
"Закончено за ", _
" секунд.", _
"Мы нашли и удалили ", _
" дупликатов.", _
"Теперь у нас есть только ", _
" уникальных значения.", _
"Дубликаты не найдены.", _
"Отменено. ", _
"Произошла ошибка! ", _
"Изменения будут отменены.", _
"Изменений не было.")
End Sub

Sub load_zh_CN
stringLists() = array("不支持多重选择区域", _
"请选择一个区域", _
"列 ", _
"选择全部(~A)", _
"选区包含了列名(~S)", _
"请选择判断重复的列（按住 Ctrl 键可以多选）(~P)：", _
"确定(~O)", _
"取消(~C)", _
"Progress", _
"Finished in ", _
" seconds.", _
"We found and deleted ", _
" duplicated values.", _
"Now we have only ", _
" unique vaues.", _
"No duplicates found.", _
"Cancelled. ", _
"An error occured! ", _
"The changes will now be undone.", _
"No changes have been made.")
End Sub

Sub load_zh_TW
stringLists() = array("不支援多重選取", _
"請選擇一個範圍", _
"欄 ", _
"全部選取(~A)", _
"選取區域包含了題名(~S)", _
"請選擇判斷重複的欄（按住 Ctrl 鍵可多重選取）(~P)：", _
"確定(~O)", _
"取消(~C)", _
"Progress", _
"Finished in ", _
" seconds.", _
"We found and deleted ", _
" duplicated values.", _
"Now we have only ", _
" unique vaues.", _
"No duplicates found.", _
"Cancelled. ", _
"An error occured! ", _
"The changes will now be undone.", _
"No changes have been made.")
End Sub

Модуль RemoveDuplicates

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

REM  *****  BASIC  *****
REM Remove duplicates
Dim oDialog1 As Object, oDoc As Object, bInProgress As Boolean

Sub RemoveDuplicates
oDoc = ThisComponent
bInProgress = False

Dim oController As Object, oSel As Object
oController = oDoc.getCurrentController
oSel = oDoc.getCurrentSelection()

InitLanguage

On Error GoTo errorExit
If not oSel.supportsService("com.sun.star.sheet.SheetCellRange") then
MsgBox getText(0) ' But other types of selection also possible, like frames, not only multiselection
Err = 14 ' Invalid parameter
End If

Dim sourceAddress
sourceAddress = oSel.getRangeAddress

If oSel.supportsService("com.sun.star.sheet.SheetCell") then
ExtendSingleSelection(oSel, oController)
Else
ClipSelectionToUsedArea(oSel, oController)
End If
On Error GoTo 0
oSel = oDoc.getCurrentSelection()

DialogLibraries.LoadLibrary("RemoveDuplicates")
oDialog1 = CreateUnoDialog( DialogLibraries.RemoveDuplicates.Options )
UpdateDialogUI
cbIncludeTitle ' Take dialog-defined checked state into account
If oDialog1.Execute() = 0 Then ' Cancel/error -> restore original selection
oController.Select(oSel.Spreadsheet.getCellRangeByPosition(sourceAddress.StartColumn, _
                                                           sourceAddress.StartRow, _
                                                           sourceAddress.EndColumn, _
                                                           sourceAddress.EndRow))
End If
errorExit:
End Sub

Sub UpdateDialogUI
oDialog1.GetControl("OptionHint").Text = getText(5)
oDialog1.GetControl("btnSelectAll").Label = getText(3)
oDialog1.GetControl("cbTitle").Label = getText(4)
oDialog1.GetControl("btnOK").Label = getText(6)
oDialog1.GetControl("btnCancel").Label = getText(7)
oDialog1.GetControl("Label1").Text = getText(8)
End Sub

Sub UpdateListBoxItems (hasTitle As Boolean)
Dim oSel, lbList
oSel = oDoc.getCurrentSelection()
lbList = oDialog1.GetControl("lbList")
Dim ColDesc()
If hasTitle Then
Dim FirstRowRange As Object ' First row of selection
FirstRowRange = oSel.getCellRangeByPosition(0, 0, oSel.Columns.Count - 1, 0)
ColDesc = FirstRowRange.getDataArray()(0)
Else
Dim i As Long, sPrefix As String
ColDesc = oSel.Columns.ElementNames
sPrefix = getText(2)
For i = lBound(ColDesc) To uBound(ColDesc)
ColDesc(i) = sPrefix & ColDesc(i)
Next i
End If
lbList.setVisible(False) ' this speeds up the update manyfold
lbList.removeItems(0, lbList.getItemCount())
lbList.addItems(ColDesc, 0)
btnSelectAllClick
lbList.setVisible(True)
End Sub

Sub ExtendSingleSelection(oSel As Object, oController As Object)
Dim oCursor
oCursor = oSel.SpreadSheet.createCursorByRange(oSel)
oCursor.collapseToCurrentRegion()
If ((oCursor.Columns.Count = 1) And (oCursor.Rows.Count = 1)) Then
MsgBox getText(1)
Err = 14 ' Invalid parameter
End If
oController.Select(oCursor)
End Sub

Sub ClipSelectionToUsedArea(oSel As Object, oController As Object)
Dim cursor As Object, curAddr As Object, newAddr As Object, modified As Boolean
newAddr = oSel.getRangeAddress
modified = False
cursor = oSel.SpreadSheet.createCursor()
cursor.gotoStartOfUsedArea(False)
curAddr = cursor.getRangeAddress()
If (newAddr.StartColumn < curAddr.StartColumn) Then
newAddr.StartColumn = curAddr.StartColumn
modified = True
End If
If (newAddr.StartRow < curAddr.StartRow) Then
newAddr.StartRow = curAddr.StartRow
modified = True
End If
cursor.gotoEndOfUsedArea(False)
curAddr = cursor.getRangeAddress()
If (newAddr.EndColumn > curAddr.EndColumn) Then
newAddr.EndColumn = curAddr.EndColumn
modified = True
End If
If (newAddr.EndRow > curAddr.EndRow) Then
newAddr.EndRow = curAddr.EndRow
modified = True
End If
If ((newAddr.StartColumn > newAddr.EndColumn) Or _
    (newAddr.StartRow > newAddr.EndRow) Or _
    ((newAddr.StartColumn = newAddr.EndColumn) And _
     (newAddr.StartRow = newAddr.EndRow))) Then
' Selection outside of used area / collapsed to single cell -> Invalid parameter
MsgBox getText(1)
Err = 14
End If
If (modified) Then
oController.Select(oSel.SpreadSheet.getCellRangeByPosition(newAddr.StartColumn, _
                                                           newAddr.StartRow, _
                                                           newAddr.EndColumn, _
                                                           newAddr.EndRow))
End If
End Sub

Function CheckInArray(checkRow As String, byRef UnionArray)
CheckInArray = True
On Error GoTo duplicateRow
UnionArray.Add(1, checkRow) ' Fails if exists
CheckInArray = False
duplicateRow:
End Function

Function GetCellRangeAddress(oSheet, StartColumn, StartRow, EndColumn, EndRow)
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
CellRangeAddress.Sheet = oSheet.RangeAddress.Sheet
CellRangeAddress.StartColumn = StartColumn
CellRangeAddress.EndColumn = EndColumn
CellRangeAddress.StartRow = StartRow
CellRangeAddress.EndRow = EndRow
GetCellRangeAddress = CellRangeAddress
End Function

Function GetCellAddress(oSheet, Column, Row)
Dim CellAddress As New com.sun.star.table.CellAddress
CellAddress.Sheet = oSheet.RangeAddress.Sheet
CellAddress.Column = Column
CellAddress.Row = Row
GetCellAddress = CellAddress
End Function

Sub MoveCells(oSheet, StartColumn, StartRow, EndColumn, EndRow, NewRow)
oSheet.copyRange(GetCellAddress(oSheet, StartColumn, NewRow), _
                 GetCellRangeAddress(oSheet, StartColumn, StartRow, EndColumn, EndRow))
End Sub

Sub RemoveCells(oSheet, StartColumn, StartRow, EndColumn, EndRow)
oSheet.removeRange(GetCellRangeAddress(oSheet, StartColumn, StartRow, EndColumn, EndRow), _
                   com.sun.star.sheet.CellDeleteMode.UP)
End Sub

Function GetRowString(aDataRow(), aCompInd()) As String
Dim l As Long, u As Long
l = lBound(aCompInd)
u = uBound(aCompInd)
If (l = u) Then
GetRowString = aDataRow(aCompInd(l))
Exit Function
End If
Dim NewArr(l To u), i As Long
For i = l To u
NewArr(i) = aDataRow(aCompInd(i))
Next i
GetRowString = Join(NewArr, Chr(1))
End Function

' Returns 1 if successful, 0 otherwise
Function doRemove() As Long

Dim StartTime As Date
StartTime = Now()

Dim bResult As Boolean, bModified As Boolean
bResult = False
bModified = False

Dim oUndoManager As Object

oDoc.lockControllers()
oDoc.addActionLock()
oUndoManager = ThisComponent.getUndoManager()
oUndoManager.enterUndoContext("Remove Duplicates")
On Error GoTo cleanup

Dim oSel As Object, oAddress As Object, aDataArray(), selectedLst(), bHasTitle As Boolean
oSel = oDoc.getCurrentSelection()
oAddress = oSel.getRangeAddress()
aDataArray = oSel.getDataArray()

selectedLst = oDialog1.GetControl("lbList").getSelectedItemsPos()
bHasTitle = oDialog1.GetControl("cbTitle").getState() > 0

Dim FirstRow As Long, LastRow As Long
FirstRow = lBound(aDataArray)
If bHasTitle Then
FirstRow = FirstRow + 1
End If
LastRow = uBound(aDataArray)

Dim ProgressBar As Object
ProgressBar = oDialog1.GetControl("ProgressBar1")
ResetProgress(ProgressBar, FirstRow, LastRow)

Dim UnionArray As New Collection, LastRowDone As Long, nUnique As Long, Pos As Long, checkStr As String
LastRowDone = FirstRow - 1
nUnique = 0
For Pos = FirstRow To LastRow
checkStr = GetRowString(aDataArray(Pos), selectedLst)
If (CheckInArray(checkStr, UnionArray)) Then ' Duplicate
If (nUnique > 0) Then
If (nUnique < (Pos - FirstRow)) Then
MoveCells(oSel.Spreadsheet, _
          oAddress.StartColumn, _
          oAddress.StartRow + Pos - nUnique, _
          oAddress.EndColumn, _
          oAddress.StartRow + Pos - 1, _
          oAddress.StartRow + LastRowDone + 1)
bModified = True
End If
LastRowDone = LastRowDone + nUnique
nUnique = 0
End If
Else ' Unique
nUnique = nUnique + 1
End If

If ((Pos > FirstRow) And (Pos Mod 100 = 0)) Then
' Check if cancelled
If (Not bInProgress) Then Err = 18 ' Interrupted by user
StepProgress(ProgressBar, 100)
End If
Next Pos

If (nUnique > 0) Then
If (nUnique < (Pos - FirstRow)) Then
MoveCells(oSel.Spreadsheet, _
          oAddress.StartColumn, _
          oAddress.StartRow + Pos - nUnique, _
          oAddress.EndColumn, _
          oAddress.StartRow + Pos - 1, _
          oAddress.StartRow + LastRowDone + 1)
bModified = True
End If
LastRowDone = LastRowDone + nUnique
End If

If (LastRowDone < LastRow) Then
RemoveCells(oSel.Spreadsheet, _
            oAddress.StartColumn, _
            oAddress.StartRow + LastRowDone + 1, _
            oAddress.EndColumn, _
            oAddress.StartRow + LastRow)
bModified = True
End If

' Make sure to set it to 100% before reporting success: it could not account yet for the last <100 elements
SetProgress(ProgressBar, LastRow)

bResult = True

cleanup:
oUndoManager.leaveUndoContext()
oDoc.unLockControllers()
oDoc.removeActionLock()

Dim TotalCount As Long, DuplicatesCount As Long, Message As String
Message = getText(9) & Format((Now()-StartTime), "[s]") & getText(10) & Chr$(13)
If (bResult) Then
doRemove = 1
TotalCount = LastRow - FirstRow + 1
DuplicatesCount = LastRow - LastRowDone
If (DuplicatesCount > 0) Then
Message = Message & getText(11) & DuplicatesCount & getText(12) & Chr$(13) & _
                    getText(13) & TotalCount - DuplicatesCount & getText(14)
Else
Message = Message & getText(15)
End If
Else
doRemove = 0
If (Err = 18) Then
Message = Message & getText(16)
Else
Message = Message & getText(17)
End If
If (bModified) Then
Message = Message & getText(18)
Else
Message = Message & getText(19)
End If
End If
MsgBox Message
If (Not bResult And bModified) Then oUndoManager.Undo()
End Function

Sub ResetProgress(ByRef ProgressBar, nMinVal As Long, nMaxVal As Long)
With ProgressBar
.setRange(nMinVal, nMaxVal)
.setValue(nMinVal)
End With
End Sub

Sub SetProgress(ByRef ProgressBar, nVal As Long)
ProgressBar.setValue(nVal)
End Sub

Sub StepProgress(ByRef ProgressBar, nStep As Long)
With ProgressBar
.setValue(.getValue() + nStep)
End With
End Sub

Sub btnCancelClick
If (bInProgress) Then
oDialog1.GetControl("btnCancel").Enable = False ' Prevent second Cancel
bInProgress = False
Else
oDialog1.endExecute()
End If
End Sub

Sub btnOKClick
bInProgress = True
' Only Cancel button is enabled in the process
oDialog1.GetControl("btnSelectAll").Enable = False
oDialog1.GetControl("cbTitle").Enable = False
oDialog1.GetControl("btnOK").Enable = False
oDialog1.GetControl("lbList").Enable = False
oDialog1.endDialog(DoRemove())
End Sub

Sub btnSelectAllClick
Dim lbList, count As Long, i As Long
lbList = oDialog1.GetControl("lbList")
count = lbList.getItemCount()
Dim SelectItems(count) As Integer
For i = 0 To count - 1
SelectItems(i) = i
Next i
lbList.selectItemsPos(SelectItems, true)
End Sub

Sub cbIncludeTitle
Dim cbTitle
cbTitle = oDialog1.GetControl("cbTitle")
If cbTitle.getState() > 0 Then
UpdateListBoxItems(True)
Else
UpdateListBoxItems(False)
End If
End Sub

Поправь перевод если нужно и размеры элементов в диалоге.

[kompilainenn]

Тогда вопрос в догонку, как локализовать пункт меню и тултип для кнопки расширения?

[bigor]

как локализовать пункт меню и тултип для кнопки

Я делал на основе AltSearch , смотрел как в нем и переносил в свое

[rami]

Тогда вопрос в догонку, как локализовать пункт меню и тултип для кнопки расширения?

Можно распаковать расширение, дописать вручную что нужно и запаковать, но ты же не в ручную собираешь расширение, должны быть, наверно, настройки для локализации.

[kompilainenn]

но ты же не в ручную собираешь расширение

это вручную, на основе того, от которого мы плясали изначально