Как сделать сайт:
  HTML
  JavaScript
  PHP
  CMS
Microsoft Office:
  Word
  Excel
  VBA
Просто о сложном
Список форумов on-line-teaching.com on-line-teaching.com
Онлайн курсы MS Office: Word, Excell. Как сделать сайт: HTML, JS, PHP
 
 FAQFAQ   ПоискПоиск   ПользователиПользователи   ГруппыГруппы   РегистрацияРегистрация 
 ПрофильПрофиль   Войти и проверить личные сообщенияВойти и проверить личные сообщения   ВходВход 

Поиск повторов в Excele

 
Начать новую тему   Ответить на тему    Список форумов on-line-teaching.com -> Excel: общие вопросы
Предыдущая тема :: Следующая тема  
Автор Сообщение
zozzow
Prizivnik - draftee
Prizivnik - draftee


Зарегистрирован: 17.02.2006
Сообщения: 2

СообщениеДобавлено: Пт Фев 17, 2006 9:36 am    Заголовок сообщения: Поиск повторов в Excele Ответить с цитатой

Привет!
Я довольно долго не занимался с макросами и подзабыл кое-что!

Допустим, задача такая. Есть таблица на листе1 из n столбцов, задача
поместить все записи(строки), у которых данные в столбце Фамилия, и столбце Имя, совпадают, в Лист 2.

Пример:
Фамилия Имя Компания
Иванов Иван Банк Москвы
Иваненко Сергей Росбанк
Иваненко Сергей Уралсиб
Сидоров Петр Газпром
Сидоров Сергей Внешторгбанк


Необходимо, чтобы оба поля
Иваненко Сергей Росбанк
Иваненко Сергей Уралсиб
поместились на лист 2, а из листа 1 удалились!

Подскажите скрипт пожалуйста!
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
AsIs
captain
captain


Зарегистрирован: 27.01.2006
Сообщения: 250
Откуда: СПб

СообщениеДобавлено: Пт Фев 17, 2006 8:28 pm    Заголовок сообщения: Ответить с цитатой

Доброе время суток.
Ну поскольку все молчат Wink попробую чего-нибудь подсказать.
Вот что получилось у меня.

Код:
Sub Transfer()
Dim intB As Integer, intC As Integer, intShift As Integer
Dim intLen As Integer
Dim strOrigin As String, strCompare As String
Dim blnEq As Boolean

' количество строк в таблице
intLen = 9

intShift = 2
intC = 2
' проход по элементам списка
Do While intC <= intLen
    strOrigin = Cells(intC, 1) & Cells(intC, 2)
    intB = intC + 1
    ' проход по элементам ниже для сравнения с текущим
    Do While intB <= intLen
        strCompare = Cells(intB, 1) & Cells(intB, 2)
        If strOrigin = strCompare Then
            ' копируем. Предполагается 3 столбца. Можно более эффективно
            Лист2.Cells(intShift, 1) = Cells(intB, 1)
            Лист2.Cells(intShift, 2) = Cells(intB, 2)
            Лист2.Cells(intShift, 3) = Cells(intB, 3)
            intShift = intShift + 1
           
            ' удаляем
            Rows(intB).Delete Shift:=xlUp
            intLen = intLen - 1
            blnEq = True
        Else
            intB = intB + 1
        End If
    Loop
    If blnEq Then
        ' копируем
        Лист2.Cells(intShift, 1) = Cells(intC, 1)
        Лист2.Cells(intShift, 2) = Cells(intC, 2)
        Лист2.Cells(intShift, 3) = Cells(intC, 3)
        intShift = intShift + 1
       
        ' удаляем
        Rows(intC).Delete Shift:=xlUp
        intLen = intLen - 1
        blnEq = False
    Else
        intC = intC + 1
    End If
Loop

End Sub


Последний раз редактировалось: AsIs (Пн Фев 20, 2006 4:19 pm), всего редактировалось 1 раз
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Отправить e-mail Посетить сайт автора
zozzow
Prizivnik - draftee
Prizivnik - draftee


Зарегистрирован: 17.02.2006
Сообщения: 2

СообщениеДобавлено: Пт Фев 17, 2006 10:02 pm    Заголовок сообщения: Ответить с цитатой

Спасибо, обязательно попробую!!!
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
Показать сообщения:   
Начать новую тему   Ответить на тему    Список форумов on-line-teaching.com -> Excel: общие вопросы Часовой пояс: GMT + 2
Страница 1 из 1

 
Перейти:  
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах


Powered by phpBB © 2001, 2005 phpBB Group
Русская поддержка phpBB