Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Объединение дубликатов строк VBA XLS / 5 сообщений из 5, страница 1 из 1
24.12.2013, 12:09
    #38510930
vitalij78
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Объединение дубликатов строк VBA XLS
Здравствуйте.
Имеется файл "Книга1.xls". На первом листе "Лист1" - элемент "Кнопка".
Для элемента "Кнопка" (название кнопки - "Выполнить") назначен обработчик-макрос "Макрос1", который осуществляет импорт
данных из файла txt (sz0.txt) в файл xls (Книга1.xls), в новый лист "sz0" книги xls.
Обработчик нажатия кнопки "Макрос1" в модуле (VBA, Module1) файла xls имеет вид:

---------------------------------------------------------------------------------------------
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
Sub Макрос1()
Application.ScreenUpdating = False
    ChDir "C:\Documents and Settings\PCV2\Рабочий стол"
    Workbooks.OpenText Filename:= _
        "C:\Documents and Settings\PCV2\Рабочий стол\sz0.txt", Origin:=1251, _
        StartRow:=4, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(21 _
        , 1), Array(29, 1), Array(38, 1), Array(46, 9), Array(52, 9), Array(59, 9), Array(63, 9), _
        Array(84, 9)), TrailingMinusNumbers:=True

    Windows("Книга1.xls").Activate
    Windows("sz0.txt").Activate
    Sheets("sz0").Select
    Sheets("sz0").Move After:=Workbooks("Книга1.xls").Sheets(1)
    Range("A1,B1,C1,D1").Select
    Selection.Font.Bold = True
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select

    While Not Columns(1).Find("ПЛИТА*") Is Nothing
    Rows(Columns(1).Find("ПЛИТА*").Row).Delete Shift:=xlUp
    Wend

    While Not Columns(1).Find("БЕЗ*") Is Nothing
    Rows(Columns(1).Find("БЕЗ*").Row).Delete Shift:=xlUp
    Wend

    While Not Columns(1).Find("ПКП*") Is Nothing
    Rows(Columns(1).Find("ПКП*").Row).Delete Shift:=xlUp
    Wend
    
    While Not Columns(1).Find("РЕШЕТКА*") Is Nothing
    Rows(Columns(1).Find("РЕШЕТКА*").Row).Delete Shift:=xlUp
    Wend

    While Not Columns(1).Find("СЕТКА*") Is Nothing
    Rows(Columns(1).Find("СЕТКА*").Row).Delete Shift:=xlUp
    Wend
    
    Sheets("Лист1").Select

Application.ScreenUpdating = True
End Sub


---------------------------------------------------------------------------------------------

необходимо объединить одинаковые строки с одинаковыми значениями, но разным количеством единиц (в столбце "Количест") и суммировать данные после объединения в столбце "Количест"

Подскажите - как решить проблему?
Файл XLS прикреплен. Ниже прикреплю файл TXT. Для проверки работы макроса необходимо исправить путь к файлу TXT в теле макроса.
...
Рейтинг: 0 / 0
24.12.2013, 12:11
    #38510935
vitalij78
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Объединение дубликатов строк VBA XLS
vitalij78Здравствуйте.
Файл TXT.
...
Рейтинг: 0 / 0
24.12.2013, 12:15
    #38510944
vitalij78
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Объединение дубликатов строк VBA XLS
vitalij78После импорта таблица имеет вид как на рисунке. К примеру - две последние строки - это дубликаты. Должны быть объединены и иметь вид одной строки: СТЕКЛО 4 ммГОМ 22 848 823 .
...
Рейтинг: 0 / 0
24.12.2013, 12:17
    #38510950
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Объединение дубликатов строк VBA XLS
Модератор: Учимся использовать тэги оформления кода - FAQ
...
Рейтинг: 0 / 0
24.12.2013, 12:47
    #38510997
vitalij78
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Объединение дубликатов строк VBA XLS
Shocker.Pro,

Понятно. Спасибо.
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Объединение дубликатов строк VBA XLS / 5 сообщений из 5, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]