Новости:

Теперь на форум можно залогиниться / зарегистрироваться с помощью ВКонтакте. Уже существующие пользователи могут связать свою учетную запись с аккаунтом ВКонтакте одним кликом в профиле пользователя http://forum.msexcel.ru/index.php?action=profile;area=account

Главное меню

Вытаскивание данных из ячейки с последующим суммированием

Автор MaxM, 30.01.2012, 14:46

« назад - далее »

MaxM

Добрый день,
Помогите решить задачку.

Суть в следующем:
Вытащить данные из ячеек в нужные ячейки чтобы с ними потом можно было работать (сложение, вычитание и прочее).

Как показывает пример, в одной ячейке находится 2 слова (столбец B), разделенные дефисом. Иногда нужное слово находиться до дефиса иногда после него. Нужно автоматом разбить ячейку, чтобы получилось 2 слова.

В столбце С - находятся цифры. Нужно чтобы в таблицу автоматом попадали правильные цифры. Если нужно слово находиться до десисе тогда берется левое число (до двоеточия, оно может быть и трехзначным), и соответственно если слово (столбец B) находится после дефиса берется число которое расположено после двоеточия (также может быть трехзначным), на примере выделено цветом.

Делал с разбивкой по столбцам 5-10 листов терпимо, но когда их около 100 это уже сложновато.

Прошу вас помочь с решением, если конечно такое вообще возможно.

MaxM

Чуть не забыл, размер данных в столбце B может быть разным от 4 букв до 40.

Jim


Serge 007

Добавил проверку на кол-во знаков
Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390

MaxM

Самая фишка-то в том что в столбце B данные постоянно меняются.
Т.е. есть информация которая копируется и вставляется в Excel.
Столбец B - данные постоянно меняются, как по длине, так и по названию.
Столбец С - данные постоянно меняются.

ячейки Е18 и F18 не исходные ячейки (до начала растета они пустые), а здесь должен быть записан готовый результат, после проведения расчетов. По нашему примеру: В Е18 - розница, в F18 - сеть.

MaxM

Тоже самое касается ячеек (E2:E6) (E10:E14).

Я пытался на втором листе изобразить то, что должно получится.
Сорри если не много не понятно.


Желательно чтобы в (E2:E6) (E10:E14) попадала информация которая встечается в столбце B более 4 раз. Если визуально разделить данные на 3 части (по горизонтали) мы видим 3 блока. В верхнем блоке информация по одному критерию, в середине по второму, в нижнем по обоим.
Можно ли сделать так чтобы при заполнении лист 1, все поле на лист 2 заполнялись автоматически.


Serge 007

Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390

GWolf

Добрый вечер!

Осмелюсь предложить вот такой вариант:
Sub razborka()
   Dim iDiapazon As Range
   Dim nREnd As Long
   Dim nCEnd As Long
   Dim nRZ As Integer
   Dim i As Long, j As Long
   
   With ThisWorkbook
       With .Worksheets("Первоначальные данные")
           'определим нижнюю (строка) крайнюю границу занятой таблицей области листа
           Set iDiapazon = .UsedRange '- используемый диапазон листа, в переменную
           With iDiapazon
               nREnd = .Row + .Rows.Count - 1 'нижнюю (строка)
           End With
           Set iDiapazon = Nothing '- чистим переменную, за ненадобностью
           
           'если перемещение в таблице следует производить исключая строки заголовка, то
           nRZ = 5 '- устанавливаем значение крайней строки заголовка
           'и организовываем проверку на существование строк с данными в таблице
           If nREnd < nRZ + 1 Then
               'если таковых необнаружилось, то "обнуляем" переменные и
               nREnd = 0
               nCEnd = 0
               nRZ = 0
               'завершаем работу макроса
               Exit Sub
           Else 'в противном случае, если строки с данными существуют, то
               'перемещаемся по строкам
               i = 0
               For i = nRZ + 1 To nREnd
                   '- пока, просто чтобы визуализировать перемещение указателя _
                      на тех ячейках, в которых есть данные
                   If IsDate(.Cells(i, 1).Value) = True Then
                       'собственно разбор
                       stroka = .Cells(i, 2).Text
                       poz = 0
                       poz = InStr(1, stroka, "-", vbTextCompare)
                       If poz > 0 Then
                           slovo1 = Trim(Mid(stroka, 1, poz - 1))
                           slovo2 = Trim(Mid(stroka, poz + 1))
                           
                           If slovo1 = "розница" And slovo2 <> "розница" And slovo2 <> "сеть" Then
                               strin = .Cells(i, 3).Text
                               poz = 0
                               poz = InStr(1, strin, "(", vbTextCompare)
                               strin = Trim(Left(strin, poz - 1))
                               poz = 0
                               poz = InStr(1, strin, ":", vbTextCompare)
                               
                               .Cells(i, 5) = Mid(strin, 1, poz - 1)
                           ElseIf slovo1 <> "розница" And slovo1 <> "сеть" And slovo2 = "розница" Then
                               strin = .Cells(i, 3).Text
                               poz = 0
                               poz = InStr(1, strin, "(", vbTextCompare)
                               strin = Trim(Left(strin, poz - 1))
                               poz = 0
                               poz = InStr(1, strin, ":", vbTextCompare)
                               
                               .Cells(i, 6) = Mid(strin, poz + 1)
                           ElseIf slovo1 = "сеть" And slovo2 <> "сеть" And slovo2 <> "розница" Then
                               strin = .Cells(i, 3).Text
                               poz = 0
                               poz = InStr(1, strin, "(", vbTextCompare)
                               strin = Trim(Left(strin, poz - 1))
                               poz = 0
                               poz = InStr(1, strin, ":", vbTextCompare)
                               
                               .Cells(i, 5) = Mid(strin, 1, poz - 1)
                           ElseIf slovo1 <> "сеть" And slovo1 <> "розница" And slovo2 = "сеть" Then
                               strin = .Cells(i, 3).Text
                               poz = 0
                               poz = InStr(1, strin, "(", vbTextCompare)
                               strin = Trim(Left(strin, poz - 1))
                               poz = 0
                               poz = InStr(1, strin, ":", vbTextCompare)
                               
                               .Cells(i, 6) = Mid(strin, poz + 1)
                           ElseIf slovo1 = "сеть" And slovo2 = "розница" Then
                               strin = .Cells(i, 3).Text
                               poz = 0
                               poz = InStr(1, strin, "(", vbTextCompare)
                               strin = Trim(Left(strin, poz - 1))
                               poz = 0
                               poz = InStr(1, strin, ":", vbTextCompare)
                               
                               .Cells(i, 5) = Mid(strin, poz + 1)
                               .Cells(i, 6) = Mid(strin, 1, poz - 1)
                           ElseIf slovo1 = "розница" And slovo2 = "сеть" Then
                               strin = .Cells(i, 3).Text
                               poz = 0
                               poz = InStr(1, strin, "(", vbTextCompare)
                               strin = Trim(Left(strin, poz - 1))
                               poz = 0
                               poz = InStr(1, strin, ":", vbTextCompare)
                               
                               .Cells(i, 5) = Mid(strin, 1, poz - 1)
                               .Cells(i, 6) = Mid(strin, poz + 1)
                           Else
                               MsgBox "ХЗ чего в строке написали!" & Chr(10) & _
                                  "(и не СЕТЬ и не РОЗНИЦА)", vbInformation + vbOKOnly, ""
                           End If
                       Else
                           MsgBox "ХЗ чего в строке написали!" & Chr(10) & _
                                  "(отсутствует дефис-разделитель)", vbInformation + vbOKOnly, ""
                       End If
                   End If
               Next i
           End If
       End With
   End With
End Sub


P.S.
Пока что выбирает данные прямо на лист "Первоначальные данные". Вы, к сожалению, не пишете,  какими средствами: формулами листа или VBA, Вам предпочтительнее решение задачи.
Путей к вершине - множество. Этот один из многих!

GWolf

Цитата: MaxM от 30.01.2012, 15:43
Можно ли сделать так чтобы при заполнении лист 1, все поле на лист 2 заполнялись автоматически.

можно, макросом.
Путей к вершине - множество. Этот один из многих!

MaxM

Цитата: GWolf от 30.01.2012, 16:29
Добрый вечер!

Осмелюсь предложить вот такой вариант:
Sub razborka()
   Dim iDiapazon As Range
   Dim nREnd As Long
   Dim nCEnd As Long
   Dim nRZ As Integer
   Dim i As Long, j As Long
   
   With ThisWorkbook
       With .Worksheets("Первоначальные данные")
           'определим нижнюю (строка) крайнюю границу занятой таблицей области листа
           Set iDiapazon = .UsedRange '- используемый диапазон листа, в переменную
           With iDiapazon
               nREnd = .Row + .Rows.Count - 1 'нижнюю (строка)
           End With
           Set iDiapazon = Nothing '- чистим переменную, за ненадобностью
           
           'если перемещение в таблице следует производить исключая строки заголовка, то
           nRZ = 5 '- устанавливаем значение крайней строки заголовка
           'и организовываем проверку на существование строк с данными в таблице
           If nREnd < nRZ + 1 Then
               'если таковых необнаружилось, то "обнуляем" переменные и
               nREnd = 0
               nCEnd = 0
               nRZ = 0
               'завершаем работу макроса
               Exit Sub
           Else 'в противном случае, если строки с данными существуют, то
               'перемещаемся по строкам
               i = 0
               For i = nRZ + 1 To nREnd
                   '- пока, просто чтобы визуализировать перемещение указателя _
                      на тех ячейках, в которых есть данные
                   If IsDate(.Cells(i, 1).Value) = True Then
                       'собственно разбор
                       stroka = .Cells(i, 2).Text
                       poz = 0
                       poz = InStr(1, stroka, "-", vbTextCompare)
                       If poz > 0 Then
                           slovo1 = Trim(Mid(stroka, 1, poz - 1))
                           slovo2 = Trim(Mid(stroka, poz + 1))
                           
                           If slovo1 = "розница" And slovo2 <> "розница" And slovo2 <> "сеть" Then
                               strin = .Cells(i, 3).Text
                               poz = 0
                               poz = InStr(1, strin, "(", vbTextCompare)
                               strin = Trim(Left(strin, poz - 1))
                               poz = 0
                               poz = InStr(1, strin, ":", vbTextCompare)
                               
                               .Cells(i, 5) = Mid(strin, 1, poz - 1)
                           ElseIf slovo1 <> "розница" And slovo1 <> "сеть" And slovo2 = "розница" Then
                               strin = .Cells(i, 3).Text
                               poz = 0
                               poz = InStr(1, strin, "(", vbTextCompare)
                               strin = Trim(Left(strin, poz - 1))
                               poz = 0
                               poz = InStr(1, strin, ":", vbTextCompare)
                               
                               .Cells(i, 6) = Mid(strin, poz + 1)
                           ElseIf slovo1 = "сеть" And slovo2 <> "сеть" And slovo2 <> "розница" Then
                               strin = .Cells(i, 3).Text
                               poz = 0
                               poz = InStr(1, strin, "(", vbTextCompare)
                               strin = Trim(Left(strin, poz - 1))
                               poz = 0
                               poz = InStr(1, strin, ":", vbTextCompare)
                               
                               .Cells(i, 5) = Mid(strin, 1, poz - 1)
                           ElseIf slovo1 <> "сеть" And slovo1 <> "розница" And slovo2 = "сеть" Then
                               strin = .Cells(i, 3).Text
                               poz = 0
                               poz = InStr(1, strin, "(", vbTextCompare)
                               strin = Trim(Left(strin, poz - 1))
                               poz = 0
                               poz = InStr(1, strin, ":", vbTextCompare)
                               
                               .Cells(i, 6) = Mid(strin, poz + 1)
                           ElseIf slovo1 = "сеть" And slovo2 = "розница" Then
                               strin = .Cells(i, 3).Text
                               poz = 0
                               poz = InStr(1, strin, "(", vbTextCompare)
                               strin = Trim(Left(strin, poz - 1))
                               poz = 0
                               poz = InStr(1, strin, ":", vbTextCompare)
                               
                               .Cells(i, 5) = Mid(strin, poz + 1)
                               .Cells(i, 6) = Mid(strin, 1, poz - 1)
                           ElseIf slovo1 = "розница" And slovo2 = "сеть" Then
                               strin = .Cells(i, 3).Text
                               poz = 0
                               poz = InStr(1, strin, "(", vbTextCompare)
                               strin = Trim(Left(strin, poz - 1))
                               poz = 0
                               poz = InStr(1, strin, ":", vbTextCompare)
                               
                               .Cells(i, 5) = Mid(strin, 1, poz - 1)
                               .Cells(i, 6) = Mid(strin, poz + 1)
                           Else
                               MsgBox "ХЗ чего в строке написали!" & Chr(10) & _
                                  "(и не СЕТЬ и не РОЗНИЦА)", vbInformation + vbOKOnly, ""
                           End If
                       Else
                           MsgBox "ХЗ чего в строке написали!" & Chr(10) & _
                                  "(отсутствует дефис-разделитель)", vbInformation + vbOKOnly, ""
                       End If
                   End If
               Next i
           End If
       End With
   End With
End Sub


P.S.
Пока что выбирает данные прямо на лист "Первоначальные данные". Вы, к сожалению, не пишете,  какими средствами: формулами листа или VBA, Вам предпочтительнее решение задачи.

На лист1 вставляется просто текст между зелеными зонами (копирую с одного источника и просто вставляю в Excel).   

GWolf

Цитата: MaxM от 30.01.2012, 16:43
На лист1 вставляется просто текст между зелеными зонами (копирую с одного источника и просто вставляю в Excel).   

Ничегошеньки не понял! Толи я нуб, то ли масина ня едет!? - А?

Ейбогу не стебаюсь! Просто я не экстасенс!
Путей к вершине - множество. Этот один из многих!

MaxM

На лист 1 вставляются первоначальные данные (копирование с другого источника).
После копирования на листе много не нужной информации, которая в настоящее время закрашена зеленым фоном.
В работу принимаются только данные (дата, название (через тире), числа).

Вот то что указано в листе должно преобразоваться в то что указакано на лист 2.

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

Постоянным на лист 1 остается только расположение для внесения информации между зелеными полями. Все данные при каждом новом внесении переменные.

Вот что-то типа того.
Сорри если непонятно, если нужно будет переформулирую.

MaxM

Представьте что на лист2 есть только пустые таблицы и больше ничего.
После того как появляется информация на лист1, она автоматом распределяется на лист2 в нужных ячейках (в таблицах).

GWolf

Доброй ночи ув. MaxM!

Итак, давайте разберемся. Макрос, который я предложил Вашему вниманию, по умолчанию, решает проблемы связанные с
Цитироватьданные постоянно будут меняться по названию
данные постоянно будут меняться по длине
числа могут быть как двухзначные так и трехзначные.

И поскольку, макрос, опредилив рабочую область исходных данных, перемещает указатель по первой колонке, останавливаясь и обрабатывая строки, которые в первой колонке содержат дату!
Я, правда, не знаю, какого рода информацию содержат зеленые блоки, но если информация не носит табличный характер, если же это таблицы, но не содержат в первой колонке дат, то все в порядке.
Ну вот. Если Вы даете "добро", то я продолжу работу по доводке предложенного макроса.
Путей к вершине - множество. Этот один из многих!

MaxM

Спасибо, всем кто откликнулся.

Всё работает, кроме одного ньюанса:
=ЕСЛИ(ПОИСК($E2;$B2)-ПОИСК("-";$B2)>0;--ПСТР($C2;НАЙТИ(" (";C2)-2;НАЙТИ(" (";C2)-НАЙТИ(":";C2)-1);"")
по этой формуле когда выпадает 3-х значное число, в таблицу заносится однозначное и приходиться испавлять или в формуле 2 на 3 или просто тупо в ячейке забивать нужную цифру (потом конечно нажимаю стрелочку назад).
Если бы это можно было как-нибудь исправить...

Прошу прощения кому запудрил мозги своей писаниной.

В принципе результат получился такой какой я и ожидал.

По поводу макроса, если есть желание то можно посмотреть что из этого выйдет.

Еще раз всем спасибо :)