 |
on-line-teaching.com
Онлайн курсы MS Office: Word, Excell. Как сделать сайт: HTML, JS, PHP
|
| Предыдущая тема :: Следующая тема
|
| Автор |
Сообщение |
zozzow
Prizivnik - draftee
Зарегистрирован: 17.02.2006
Сообщения: 2
|
 Добавлено: Пт Фев 17, 2006 9:36 am Заголовок сообщения: Поиск повторов в Excele |
 |
|
Привет!
Я довольно долго не занимался с макросами и подзабыл кое-что!
Допустим, задача такая. Есть таблица на листе1 из n столбцов, задача
поместить все записи(строки), у которых данные в столбце Фамилия, и столбце Имя, совпадают, в Лист 2.
Пример:
Фамилия Имя Компания
Иванов Иван Банк Москвы
Иваненко Сергей Росбанк
Иваненко Сергей Уралсиб
Сидоров Петр Газпром
Сидоров Сергей Внешторгбанк
Необходимо, чтобы оба поля
Иваненко Сергей Росбанк
Иваненко Сергей Уралсиб
поместились на лист 2, а из листа 1 удалились!
Подскажите скрипт пожалуйста! |
|
| Вернуться к началу |
|
 |
AsIs
captain
Зарегистрирован: 27.01.2006
Сообщения: 250
Откуда: СПб
|
| Добавлено: Пт Фев 17, 2006 8:28 pm Заголовок сообщения: |
|
|
Доброе время суток.
Ну поскольку все молчат  попробую чего-нибудь подсказать.
Вот что получилось у меня.
| Код: | 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 раз |
|
| Вернуться к началу |
|
|
zozzow
Prizivnik - draftee
Зарегистрирован: 17.02.2006
Сообщения: 2
|
| Добавлено: Пт Фев 17, 2006 10:02 pm Заголовок сообщения: |
|
|
| Спасибо, обязательно попробую!!! |
|
| Вернуться к началу |
|
|
|
|
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах
|
|
FAQ
Поиск
Пользователи
Группы
Регистрация
Профиль
Войти и проверить личные сообщения
Вход
