powered by simpleCommunicator - 2.0.58     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Объединение дубликатов строк VBA XLS
5 сообщений из 5, страница 1 из 1
Объединение дубликатов строк VBA XLS
    #38510930
vitalij78
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Здравствуйте.
Имеется файл "Книга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
Объединение дубликатов строк VBA XLS
    #38510935
vitalij78
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
vitalij78Здравствуйте.
Файл TXT.
...
Рейтинг: 0 / 0
Объединение дубликатов строк VBA XLS
    #38510944
vitalij78
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
vitalij78После импорта таблица имеет вид как на рисунке. К примеру - две последние строки - это дубликаты. Должны быть объединены и иметь вид одной строки: СТЕКЛО 4 ммГОМ 22 848 823 .
...
Рейтинг: 0 / 0
Объединение дубликатов строк VBA XLS
    #38510950
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Модератор: Учимся использовать тэги оформления кода - FAQ
...
Рейтинг: 0 / 0
Объединение дубликатов строк VBA XLS
    #38510997
vitalij78
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro,

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


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