Мужики, протяните руку помощи страдающему Excell!

[Deja-vu]

Привет всем мужикам!
Выручайте.. иначе погибну...
Начальник мой удумал наладить на фирме автоматическую обработку информации... я уже сделал почти все, что надо, но на двух вещах остановился... вот одна из "проблем"...

В Excell у меня есть список команд для робота, что-то типа вот этого...

T1G0X25Z37M3
T3G1F3.34
T2S3000M3
T12S200M4
T323M3000
T241S1000

и так далее...

ЗАДАЧА: cделать специальную сортировку так, чтобы на другой лист перенести только строчки в которых первые два символа уникальные...
Проще говоря, если у меня есть строчки:

T2
T5
T233
T43
T518

То надо, чтобы остались только строчки с:

T2
T5
T43

Строчки, где содержатся "T233" и "T518" - не нужно переносить на новый лист, потому, что первые два символа это дубликаты... Тех, которые уже были раньше... А мне дубликаты как раз и не нужны...
Как избавиться от дубликатов?

Мужики, я понимаю, что занимаю ваше время. Но в случае решения, которое будет работать, могу помочь найти любую прогу или лекарство к ней или вообще, что-то редкое из инета... песню, допустим... у меня доступ к АДСЛ линии. В накладе не останусь.

[alibek]

Код: Выделить всё

Dim Sh1 As Worksheet, Sh2 As Worksheet, I As Long, R As Long, N As Long, S As String, C() As String, cnt As Long
Const ActualChars As Long = 2, MaxItems As Long = 1000
Set Sh1 = Sheets("Лист1")
Set Sh2 = Sheets("Лист2")
' массив нужен только для ускорения работы;
' доступ к элементам массива на порядок быстрее, чем к Cells
ReDim C(1 To MaxItems)
I = 1
R = I
cnt = 0
Do
  S = Sh1.Cells(I, 1).Text
  If Len(S) = 0 Then Exit Do
  I = I + 1
  If I > cnt Then Exit Do
  For N = cnt To 1 Step -1
    If Left$(S, ActualChars) = Left$(C(N), ActualChars) Then Exit For
  Next N
  If N = 0 Then
    cnt = cnt + 1
    C(cnt) = S
    Sh2.Cells(R, 1) = S
    R = R + 1
  End If
Loop
Erase C()
Set Sh2 = Nothing
Set Sh1 = Nothing


Что-то типа того.

[Deja-vu]

alibek Спасибо, но не работает...
Вместо шитов вписал названия листов, а сам код поместил в макрос...
На первом листе были данные, после запуска кода ничего не произошло... второй лист остался пустым...
Может можно что-то сделать?

[alibek]

Блин... Очепятался.
Замени
If I > cnt Then Exit Do
на
If I > MaxItems Then Exit Do

[Deja-vu]

alibek Программа работает! Ура!
Я тебе послал в приват сообщение с моим емэйлом...
Спасибо всем, кто заглянул в эту тему!