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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 24.09.2014, 10:50   #1
Евгений Таб
Форумчанин
 
Аватар для Евгений Таб
 
Регистрация: 09.08.2013
Сообщений: 202
Радость Удалить дупликаты + ВПР и СЦЕПИТЬ через символ

Добрый день, коллеги!

Нуждаюсь в решении проблемы создания макроса.
Во вложении файл, вкладка был и стал.
По задумке после работы макроса из БЫЛ становится СТАЛ.

Мои раздумья меня привели к:
сначала рекордером удаляем дубликаты столба А и B, дальше...все, нужно ВПР и СЦЕПЛЯТЬ.

Жду помощи. Спасибо!
Вложения
Тип файла: zip ПРИМЕРЧИК.zip (10.2 Кб, 11 просмотров)
Евгений Таб вне форума Ответить с цитированием
Старый 24.09.2014, 16:35   #2
Евгений Таб
Форумчанин
 
Аватар для Евгений Таб
 
Регистрация: 09.08.2013
Сообщений: 202
По умолчанию

Или может как то формулами.......
Евгений Таб вне форума Ответить с цитированием
Старый 24.09.2014, 18:38   #3
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

Код:
Sub PrepareData()
  Dim dc As Object, r As Long, k As String, a1(), a2()
  Set dc = CreateObject("Scripting.Dictionary")
  For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    k = Cells(r, 1) & chr(9) & Cells(r, 2)
    If dc.exists(k) Then dc(k) = dc(k) & "." & Cells(r, 3) Else dc.Add k, Cells(r, 3)
  Next
  a1 = dc.Keys
  ReDim a2(0 To dc.Count - 1)
  For r = 0 To dc.Count - 1
    a2(r) = Split(a1(r), chr(9))(1)
    a1(r) = Split(a1(r), chr(9))(0)
  Next
  With Worksheets(Worksheets.Count)
    .Cells(2, 1).Resize(dc.Count, 1).Value = WorksheetFunction.Transpose(a1)
    .Cells(2, 3).Resize(dc.Count, 1).Value = WorksheetFunction.Transpose(a2)
    .Cells(2, 3).Resize(dc.Count, 1).Value = WorksheetFunction.Transpose(dc.items)
  End With
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 24.09.2014, 20:43   #4
Евгений Таб
Форумчанин
 
Аватар для Евгений Таб
 
Регистрация: 09.08.2013
Сообщений: 202
По умолчанию

Цитата:
Сообщение от IgorGO Посмотреть сообщение
Код:
Sub PrepareData()
  Dim dc As Object, r As Long, k As String, a1(), a2()
  Set dc = CreateObject("Scripting.Dictionary")
  For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    k = Cells(r, 1) & chr(9) & Cells(r, 2)
    If dc.exists(k) Then dc(k) = dc(k) & "." & Cells(r, 3) Else dc.Add k, Cells(r, 3)
  Next
  a1 = dc.Keys
  ReDim a2(0 To dc.Count - 1)
  For r = 0 To dc.Count - 1
    a2(r) = Split(a1(r), chr(9))(1)
    a1(r) = Split(a1(r), chr(9))(0)
  Next
  With Worksheets(Worksheets.Count)
    .Cells(2, 1).Resize(dc.Count, 1).Value = WorksheetFunction.Transpose(a1)
    .Cells(2, 3).Resize(dc.Count, 1).Value = WorksheetFunction.Transpose(a2)
    .Cells(2, 3).Resize(dc.Count, 1).Value = WorksheetFunction.Transpose(dc.items)
  End With
End Sub
Привет, IgorGO. Спасибо за помощь в решении.

Есть несколько вопросов.

Запускаю макрос с листа (БЫЛ), но как-то некорректно он "пилит" диапазоны. Пустой столб "B" + в "C" что-то через запятую, а чтото через точку... непонятно, может я чтото не так делаю?
Евгений Таб вне форума Ответить с цитированием
Старый 24.09.2014, 22:06   #5
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

есть несколько ответов:
пустой столбец В из-за опечатки в строке
Код:
.Cells(2, 2).Resize(dc.Count, 1).Value = WorksheetFunction.Transpose(a2)
точки, запятые в колонке С - это проблема порождена принятым Вами способом разделить значения точками.
когда в словарь попадает значение 1.2, а потом это значение выкладывается в ячейку - эксель решает что 1.2 - это число одна целая две десятых, и записывает в ячейку число (у Вас в системе разделитель дробной и целой части, видимо, запятая, вот и появляются запятые, там где было обьеденено ровно 2 значения), а например 1.2.3 - это не число поэтому именно в таком виде оно и отображается в ячейке (хотя 1.2.3 ексель еще мог воспринять как дату 1 февраля 2003 года, просто у вас там числа 5000.5000.5000 - это на дату не похоже)
вместо точки сделайте разделитель пробел - все станет на свои места

удачи!
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете

Последний раз редактировалось IgorGO; 24.09.2014 в 22:09.
IgorGO вне форума Ответить с цитированием
Старый 25.09.2014, 05:48   #6
Евгений Таб
Форумчанин
 
Аватар для Евгений Таб
 
Регистрация: 09.08.2013
Сообщений: 202
По умолчанию

Понял в чем проблема, решил ее разделением через "_", а потом макросом заменяю массово "_" на "."

Нарисовалась новая проблема

Есть какое-то ограничение на сцепку? Во вложении "рабочие" числа и когда значения "которые сцепляем" (выделены желтым) - "прогоняем" через макрос - выдает ошибку.

В чем может быть проблема?
Вложения
Тип файла: zip ПРИМЕРЧИК.zip (18.9 Кб, 9 просмотров)
Евгений Таб вне форума Ответить с цитированием
Старый 25.09.2014, 12:18   #7
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

Код:
Sub PrepareData()
  Dim dc As Object, r As Long, k As String, a1(), a2()
  Set dc = CreateObject("Scripting.Dictionary")
  For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    k = Cells(r, 1) & Chr(9) & Cells(r, 2)
    If dc.exists(k) Then dc(k) = dc(k) & "_" & Cells(r, 3).Value Else dc.Add k, Cells(r, 3).Value
  Next
  a1 = dc.Keys:  ReDim a2(1 To dc.Count, 1 To 3)
  For r = 1 To dc.Count
    a2(r, 1) = Split(a1(r - 1), Chr(9))(0)
    a2(r, 2) = Split(a1(r - 1), Chr(9))(1)
    a2(r, 3) = dc(a1(r - 1))
  Next
  Worksheets(Worksheets.Count).Cells(2, 1).Resize(dc.Count, 3).Value = a2
  ' Application.Run "to4ka"
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Символ переноса строк для функции =СЦЕПИТЬ Jeni Microsoft Office Excel 6 19.06.2017 08:47
Удалить символ ' в строке Aleksandr Общие вопросы Delphi 5 03.12.2013 14:54
Как сцепить данные с определенного диапазона ячеек через запятую Alex___ Microsoft Office Excel 5 21.01.2013 23:42
ВПР и подстрочный символ Foxx Microsoft Office Excel 2 12.11.2010 14:40
Удалить символ alerzo Помощь студентам 1 06.03.2010 20:03