Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Для новичков > макрос через delphi


Автор: bushkurta 22.5.2013, 13:26
помогите исправить код макроса.
подключил макрос (поиск дубликатов в таблице excel) к делфи  поиск дублей идет.но неправельно. удаляет все строки. сначала одинаковые, при повторном включении удаляет все попорядку хотя там нет повторений).

код макроса
Код

Sub q()
 Dim iListCount As Integer
Dim iCtr As Integer

' Для ускорения работы макроса обновление экрана отключается.
Application.ScreenUpdating = False

' Получение числа записей для поиска.
iListCount = Sheets("Sheet1").Range("A1:J100").Rows.Count
Sheets("Sheet1").Range("A1:J100").Select
' Цикл по всем записям до последней.
Do Until ActiveCell = ""
   ' Цикл по записям.
   For iCtr = 1 To iListCount
      If ActiveCell.Row <> Sheets("Sheet1").Cells(iCtr, 1).Row Then
         ' Сравнение следующей записи.
         If ActiveCell.Value = Sheets("Sheet1").Cells(iCtr, 1).Value Then
            ' Если совпало, удалить строку.
            Sheets("Sheet1").Cells(iCtr, 1).Delete xlShiftUp
               ' Увеличение счетчика строк на 1 для учета удаленной строки.
               iCtr = iCtr + 1
         End If
      End If
   Next iCtr
   ' Переход к следующей записи.
   ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Готово!"
End Sub



M
Poseidon		При вставке фрагмента кода используйте копку "Код"

Автор: Beltar 22.5.2013, 17:13
Так это на форум по VBA по идее, или ты его на Паскаль переписал?

Автор: kami 22.5.2013, 22:30
Beltar, думаю, что вызов макроса идет через метод XlsApplication.Run.
bushkurta, на форуме VBA это сделали бы красивее, но можно, например, так:

Код

Set myRange = Worksheets("Ëèñò1").Cells(1, 1).CurrentRegion

For i = 1 To myRange.Rows.Count - 1
  Set CurrentCell = myRange.Cells(i, 1)
  For j = myRange.Rows.Count To i + 1 Step -1
    If CurrentCell.Value = myRange.Cells(j, 1).Value Then
      myRange.Rows(j).Delete
    End If
  Next j
Next i

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)