Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы Поиск в этой теме
Старый 17.07.2009, 11:41   #1
provodnikam
Пользователь
 
Регистрация: 17.07.2009
Сообщений: 31
Восклицание МАКРОС НА ПОИСК, СУММИРОВАНИЕ И УДАЛЕНИЕ ПОВТОРЯЮЩИХСЯ СТРОК

Здрасте!!!
Ребят, есть ОЧЕНЬ большая таблица в Эксель....поэтому сводные таблицы её не берут
Помогите создать макрос суть которого в следующем:
Если встречается строка с одинаковым наименованиес материала, то её ПОЛНОСТЬЮ нужно приплюсовать к имеющейся строке выше и удалить.
Пример во вложении
Вложения
Тип файла: zip ИСХОДНИК.zip (30.5 Кб, 140 просмотров)
Тип файла: zip ИТОГ.zip (28.4 Кб, 115 просмотров)

Последний раз редактировалось provodnikam; 17.07.2009 в 11:44. Причина: Вложение подкрепил
provodnikam вне форума
Старый 17.07.2009, 12:43   #2
provodnikam
Пользователь
 
Регистрация: 17.07.2009
Сообщений: 31
По умолчанию

PHP код:
Rem Attribute VBA_ModuleType=VBADocumentModule
Sub Лист1
Rem Option Explicit
Rem 
Private sh As Worksheet 'лист на котором происходит подсчёт
Rem 
Rem '
Основная процедура
Rem 
Private Sub CommandButton1_Click()
Rem    Set sh ActiveSheet 'лист на котором происходит подсчёт
Rem    Application.ScreenUpdating = False '
временно отрубаем обновление экрана
Rem    Call DeleteEmptyRows 
'Удаляем все пустые записи
Rem    Call Sortirovka '
Сортируем по названию
Rem    Call Summiruem 
'Находим одинаковые записи и суммируем их значения
Rem    Application.ScreenUpdating = True '
надо бы снова включить обновление экрана...
Rem End Sub
Rem 
Rem 
'Удаляем все пустые записи
Rem Private Sub DeleteEmptyRows()
Rem    '
LastRow последняя используемая строкаколичество строк
Rem    
'r - очередная строка
Rem    Dim LastRow As Long, r As Long
Rem    With sh.UsedRange
Rem       LastRow = .Rows.Count '
количество строк в используемом диапазоне
Rem       
For LastRow To 3 Step -'от последней строки и до третьей
Rem          If .Cells(r, 1) = "" Then .Rows(r).Delete '
нет названия удаляем всю строку!!!
Rem       Next
Rem    End With
Rem End Sub
Rem 
Rem 
'Сортируем записи по названию
Rem Private Sub Sortirovka()
Rem    Dim endRow As Long '
номер последней строки
Rem    With sh
.UsedRange
Rem       
.Cells(31).End(xlDown).Select 'выделяем - от первой записи и до последней
Rem       endRow = ActiveCell.Row
Rem       '
сортируем от первой записи и до последней по названиям
Rem       
.Range(Cells(31), Cells(endRow3)).Sort key1:=Columns(1)
Rem    End With
Rem End Sub
Rem 
Rem 
'Находим одинаковые записи и суммируем их значения
Rem '
Напоминаючто записи уже отсортированы по названиям
Rem 
'У записей есть НАЗВАНИЯ (1-й столбец) и ЗНАЧЕНИЯ (2-й столбец)
Rem Private Sub Summiruem()
Rem    Dim i As Long '
номер строки текущей записи
Rem    Dim sum 
As Double 'общая сумма
Rem    '
строковые переменные для названий текущей записи и не-числа в значениях записей
Rem    Dim tek
tek2brak As String
Rem    i 
3sum 0brak "" 'начинаем с 3-й строчки, пока всё по нулям
Rem    '
Итакпоехали!
Rem    Do
Rem       With sh
Rem          tek 
= .Cells(i1'название очередной записи
Rem          tek2 = .Cells(i + 1, 1) '
название записи строкой ниже
Rem          
If Not IsNumeric(.Cells(i2)) And .Cells(i2) <> "" Then
Rem             
'Если значение записи не-число, то кидаем в "брак"
Rem             brak = brak & " [" & .Cells(i, 2) & "]"
Rem          Else
Rem             sum = sum + .Cells(i, 2) '
приплюсовали к общей сумме если это было число
Rem          End 
If
Rem          If tek tek2 Then 'если две подряд записи с одинаковыми названиями
Rem          '
то первую удаляем так как её значение к сумме уже приплюсовали
Rem             
.Rows(i).Delete
Rem          
Else 'ну а если названия разные...
Rem             .Cells(i, 2) = sum '
записываем для текущей записи всё что подсчитали
Rem             
'если были нечисловые значения - сообщаем об этом в той же строке
Rem             If brak <> "" Then .Cells(i, 3) = "БРАК - " & brak
Rem             sum = 0 '
обнуляем сумму
Rem             brak 
"" 'очищаем корзинку для "брака"
Rem             i = i + 1 '
переходим к записи строкой ниже с другим названием!
Rem          End If
Rem       End With
Rem    Loop Until tek 
"" 'и так до тех пор пока не закончатся записи
Rem End Sub
Rem 
Rem 
Rem 
End Sub 
provodnikam вне форума
Старый 17.07.2009, 12:44   #3
provodnikam
Пользователь
 
Регистрация: 17.07.2009
Сообщений: 31
По умолчанию

предложили вышеуказанный коддд....однако, он только ссцмирует первую и вторую колонку, а надо всё....
плиз, помогите написать макрос...лучше в примере на xls
provodnikam вне форума
Старый 18.07.2009, 08:59   #4
The_Prist
Участник клуба
 
Аватар для The_Prist
 
Регистрация: 17.07.2009
Сообщений: 1,088
По умолчанию

Посмотрите, может подойдет. Единственное, лучше сначала копируйте весь лист в другое место, т.к. макрос преобразует все формулы на листе в значения.
Вложения
Тип файла: rar ИСХОДНИК.rar (27.1 Кб, 458 просмотров)
WebMoney - R298726502453; Яндекс.Деньги - 41001332272872
www.excel-vba.ru
The_Prist вне форума
Старый 18.07.2009, 16:16   #5
provodnikam
Пользователь
 
Регистрация: 17.07.2009
Сообщений: 31
По умолчанию

Спасибо - попробую попозже....обязательно напишу!!!!!!!!!!!!
provodnikam вне форума
Старый 20.07.2009, 07:03   #6
provodnikam
Пользователь
 
Регистрация: 17.07.2009
Сообщений: 31
По умолчанию

СПАСИБО!!!!!!
Всё работает!!!!:-)
provodnikam вне форума
Старый 24.09.2009, 11:51   #7
zhdanov_as
Новичок
Джуниор
 
Регистрация: 24.09.2009
Сообщений: 2
По умолчанию Ребят помогите кто сможет, пожалуйста

Помогите пожалуйста в такой ситуации, нужен макрос: есть таблица, формируется она довольно таки часто "во вложенных файлах", там есть одинаковый вид продукции, к примеру "сталь арматурная А3 ф10 (6) А500С ГОСТ5781-82" и "сталь арматурная А3 ф10 (11.7) А500С СТО АСЧМ 7-93", в скобках обозначается длина, также указывается коэффициент к каждой позиции, нужно чтобы оставалось лишь по одной позиции с наибольшим коэффициентом, отбор должен идти к примеру так "сталь арматурная А3 ф10" не учитывая длины и всех остальных обозначений. А то приходится самому сидеть и удалять балки, арматуру, шестигранники, очень долго по времени занимает. Заранее большое вам спасибо!
Вложения
Тип файла: zip 111.zip (18.4 Кб, 58 просмотров)
zhdanov_as вне форума
Старый 29.09.2009, 01:47   #8
doober
Старожил
 
Аватар для doober
 
Регистрация: 02.05.2009
Сообщений: 3,907
По умолчанию

Посмотрите здесь,Вам должно помочь в работе
Анализ,обработка данных Недорого
doober вне форума
Старый 30.09.2009, 09:50   #9
zhdanov_as
Новичок
Джуниор
 
Регистрация: 24.09.2009
Сообщений: 2
По умолчанию

Огромное спасибо, все отлично работает! Теперь экономлю на работе кучу времени.
zhdanov_as вне форума
Старый 28.11.2010, 14:15   #10
vashkostya
Новичок
Джуниор
 
Регистрация: 28.11.2010
Сообщений: 1
По умолчанию

Доброго времени суток.
Помогите создать макрос, чтобы предприятия в списке не повторялись. А суммы впредприятий которые повторяюстя в столбцах суммировались. Очень нужно! Заранее спасибо!

http://www.programmersforum.ru/attac...1&d=1290943122
Вложения
Тип файла: rar Копия 3_кв_2009.rar (46.6 Кб, 111 просмотров)

Последний раз редактировалось vashkostya; 28.11.2010 в 14:20.
vashkostya вне форума
Закрытая тема


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Удаление повторяющихся данных demonic Microsoft Office Access 6 19.02.2009 11:09
Удаление повторяющихся записей gavrylyuk Microsoft Office Excel 3 28.06.2008 08:10
SQL-запрос на выбор повторяющихся строк stepchild БД в Delphi 2 07.06.2008 10:52
Поиск повторяющихся значений Flangini Microsoft Office Excel 23 22.02.2008 15:57
Макрос: удаление строк если в колонке А число 5 Dorvir Microsoft Office Excel 22 15.02.2008 06:25