Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > VB6 > макрос, EXEL

Автор: Алер 27.11.2004, 20:25

Уважаемые многопытные пользователи.
Задача: через макрос в существующем столбце выделить цветом совпадающие значения и просуммиовать их.

Заранее благодарен за помощь.

Автор: Enflout 27.11.2004, 20:34

Сделай так:
Сервис - Макрос - Начать запись
Далее делаешь все что тебе надо и останавливаешь процесс записи.
Сервис - Макрос - Макросы
Смотришь исходник своего макроса
Все smile

Автор: Guest 27.11.2004, 20:36

Цитата(Templar @ 27.11.2004, 20:34)

Да, но там будут конкретные ячейки, а мне нужно для всех...

Автор: Enflout 27.11.2004, 20:40

Цитата(Guest @ 27.11.2004, 20:36)

Да, но там будут конкретные ячейки, а мне нужно для всех...

Во-первых не во всех, а всего лишь в конкретном столбце по условию вопроса.
Во-вторых, если ты сделаешь щелчок на название столбца, выделятся все ячейки этого столбца.
smile

Добавлено @ 20:44
Выделяем столбец C:
Columns("C:C").Select

Автор: Guest 27.11.2004, 20:48

Цитата(Templar @ 27.11.2004, 20:40)

Добавлено @ 20:44
Выделяем столбец C:
Columns("C:C").Select

Что-то я не совсем понял. Весь столбик-то можно выделить, а как в нем найти повторяющиеся значения? Там есть и уникальные значения.

Автор: Enflout 27.11.2004, 21:04

Ладно не заморачивайся, есть способ попроще имхо.
Поясню принцип:
Притсуждаешь переменной номер первой ячейки столбца и запоминаешь это значение. Далее прогоняешь цикл на соответствие значений этой ячейки и всех остальных в этом столбце и так до последней ячейки(увеличивая номер ячейки).
Это очень долго и противно, но зато полегче, чем предыдущий способ.
Добавлено @ 21:06
Сравнение:
If Range(a) = Range(b) Then Range© = Range(a) + Range(b)
a, b, c - номера соответсвенных ячеек.

Автор: Алер 28.11.2004, 09:26

Цитата(Templar @ 27.11.2004, 21:04)

Да уж наверное придется делать так...,но это почти ручной способ

Автор: Staruha 28.11.2004, 22:33

Не придется ,от ныне и во веки веков!

Код


Private Sub CommandButton1_Click()
d = Лист1.UsedRange.Rows.Count
c = UsedRange.Rows.Count
For rwIndex = 1 To d
For rwIn = 1 To c
Range("D" & rwIndex).Value = Range("A" & rwIn).Value

If Range("A" & rwIndex).Value = Range("D" & rwIndex).Value Then

Range("C" & rwIndex).Value = Range("C" & rwIndex).Value + Range("B" & rwIn).Value

End If
Next rwIn
Range("D" & rwIndex).Value = ""
Next rwIndex

End Sub

С цветом вот тоько не успела.Пока не соображу как.Может кто
подскажет.
Row(rwIndex).Interior.ColorIndex = 3- красит все подряд.

Автор: Jureth 29.11.2004, 07:40

Может я чего недоглядел, но у меня получилось так:

Код

Sub search()
    Dim Count%, b%, F As Boolean
    Columns(1).Interior.ColorIndex = xlNone 'убираем цвета
    Columns(2).Clear 'Очищаем столбец сумм
    Count = UsedRange.Rows.Count 'Взято из предыдущего сообщения
    b = 0
    For i = 1 To Count - 1
        F = True
        'раз просили покрасить, то по цвету мы и будем смотреть - проверяли уже эту ячейку или нет
        If Cells(i, 1).Interior.Color <> vbRed Then
            For j = i + 1 To Count
                If Cells(i, 1).Value = Cells(j, 1).Value Then
                    'красим...
                    Cells(i, 1).Interior.Color = vbRed
                    Cells(j, 1).Interior.Color = vbRed
                    'если это первое совпадение данных чисел
                    If F Then
                        b = b + 1
                        Cells(b, 2).Value = Cells(i, 1).Value + Cells(j, 1).Value
                        F = Not F
                    Else 'если нет
                        Cells(b, 2).Value = Cells(b, 2).Value + Cells(j, 1).Value
                    End If
                End If
            Next j
        End If
    Next i
End Sub

программа ищет значения в первом столбце, суммы выводит во втором.

Автор: Guest 29.11.2004, 09:05

Цитата(Jureth @ 29.11.2004, 07:40)

Count = UsedRange.Rows.Count 'Взято из предыдущего сообщения

Ругается run-time error '424'

Автор: Staruha 29.11.2004, 09:59

Все получилось!Закрасила как просил
Private Sub CommandButton1_Click()
d = UsedRange.Rows.Count
c = UsedRange.Rows.Count
For rwIndex = 1 To d
For rwIn = 1 To c
Range("D" & rwIndex).Value = Range("A" & rwIn).Value

If Range("A" & rwIndex).Value = Range("D" & rwIndex).Value Then

Range("C" & rwIndex).Value = Range("C" & rwIndex).Value + Range("B" & rwIn).Value

End If
If Range("A" & rwIndex).Value = Range("A" & rwIn).Value Then
k = 1

Else
k = k + 1

End If
Rows(rwIndex).Interior.ColorIndex = k
Next rwIn
Range("D" & rwIndex).Value = ""
Next rwIndex

End Sub
Извиняюсь за оформление ,но у меня что то с настройками

Автор: Guest 29.11.2004, 10:07

еще бы знать как пользоватся, а то при запуске ругается Ругается run-time error '424' на строчку d = UsedRange.Rows.Count

Автор: Гость_Старуха 29.11.2004, 11:50

У меня не ругается.Попробуй обьявить переменную As Integer d, c ,k

Автор: Алер 29.11.2004, 13:21

Дело в том, что я совсем уж начинающий и поэтому для меня не все понятно.
Там наверное вначале должно быть имя макроса, типа Sub Макрос1().....End Sub, если ставлю непонимает Private Sub CommandButton1_Click().
А какова технология применения данного макроса? Нужно ли указыватьявно номер столбца?

Автор: Гость_Старуха 29.11.2004, 13:44

Открываешь лист нажимаешь правую кнопку мышки,выберешь VB и Элементы управления.
С Э\управления стащишь кнопку,хлопнешь по ней два раза и вставляй код. И еще с цветом поэксперементируй вот так -

Rows(rwIndex).Interior.ColorIndex = k + 1 + "14

А вообще тебе ко мне на сайт надо зайти. Я когда училась ,так сама себе экзамены здавала.Там для чайников в самый раз.Сайт бесплатный.
Переменные не забудь обьявить

Автор: Guest 29.11.2004, 14:10

Цитата

Извиняюсь за беспокойство.

А как перемееные объявить?
Адрес сайта какой?

Автор: Гость_Старуха 29.11.2004, 16:32

Код


Dim d As Integer
Dim c As Integer
Dim k As Integer

Поставь вначале кода.

Автор: Jureth 30.11.2004, 06:52

Цитата

Ругается run-time error '424'

А у тебя какая версия офиса? И что пишет после кода?

Автор: Staruha 30.11.2004, 13:46

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

Private Sub CommandButton1_Click()
Dim d As Integer
Dim c As Integer
Dim k As Integer

d = UsedRange.Rows.Count
c = UsedRange.Rows.Count

For rwIndex = 1 To d

For rwIn = 1 To c

If Range("A" & rwIndex).Value = Range("A" & rwIn).Value Then

Range("C" & rwIndex).Value = Range("C" & rwIndex).Value + Range("B" & rwIn).Value

k = 1

Else
k = k + 1

End If
Rows(rwIndex).Interior.ColorIndex = k + 1 + "14"
Next rwIn
Next rwIndex

End Sub
А то что ты сумму в одну ячейку поместил мне понравилось ,только пока не получилось

Автор: Jureth 30.11.2004, 14:02

Сделать раскраску разными цветами, ИМХО, не проблема - сам способ ты уже предлагала, только проверку нужно исправить:

Код

If Cells(i, 1).Interior.ColorIndex = xlNone Then

PS: Пользуйся тегом [code=vb], plz - а то читать невозможно.

Автор: Гость_Старуха 30.11.2004, 15:03

Я дома пользуюсь. А на работе подсветка даже не показывается.У меня правов Администратора нет . И администратор уволился. Даже смалики не вставляются.

Автор: Алер 6.12.2004, 14:44

Всем большое спасибо за помощь

Автор: Guest 6.12.2004, 15:32

Цитата

С цветом вот тоько не успела.Пока не соображу как.Может кто
подскажет.

в том же цикле для Cells или Range присваивать ) нужный .Interior.ColorIndex

Автор: Staruha 6.12.2004, 16:24

Цитата

в том же цикле для Cells или Range присваивать ) нужный .Interior.ColorIndex

- Поезд ушел smile