[решено] распределение по столбцам

[Elizavetta]

Уважаемые форумчане, помогите, пожалуйста.
Смотрите, в экселе желтым выделила три категории
red,green,grey
Каждая категория имеет подкатегории
например для green
"Чистая прибыль" 1 458 тыс. руб
"Размер непогашенного обязательства не превышает "300 000 руб
"Нет в реестре массовых руководителей"
"Чистая прибыль" 1 814 тыс. руб
...
...
Но проблема в том, что они идут неструктурировано
наппример для одной компании "Чистая прибыль" в столбце green1, а для другой в green2.
Ну просто не по порядку для каждой компании вбивали, видимо данные, вот так и получается черти как расположены.
Можно ли каждую такую категорию встроить в отдельный столбец и переписать туда значения, но чтобы согласовались наблюдения
тут всего 11 наблюдений из 1500.

[okshef]

В каких строчках вашего файла ошибки? Вам не кажется, что некоторые данные просто сдвинуты?

[Elizavetta]

okshef, здравствуйте! Нет они не сдвинуты. Немного поясню. Для фирм есть три категории опасности\
RED
GREEN
GREY
Каждая категория представляет собой ряд показателей. Для GREEN их от 8-10 может быть.(чистая прибыль, дела о банкротстве...)
Проблема в том, что для фирм они заполнялись в разных порядках

Фирма 1: 1,4,5,6,8,2,3,4(это номера показателей)
Фирма 2: 4,6,1,5,8,3
...
И так далее

Задача перестроить эти показатели по порядку для каждой фирмы. Но с сохранением структуры наблюдений по другим показателям(помимо RED,GREY,GREEN есть другие колонки).

Если я непонятно объяснила, Вы можете мне задавать уточняющие вопросы.

[okshef]

Elizavetta, чтобы выполнить задачу, нужно знать ВСЕ возможные критерии соотнесения событий к категориям и подкатегориям. Вот ваш текст
Каждая категория имеет подкатегории
например для green
"Чистая прибыль" 1 458 тыс. руб
"Размер непогашенного обязательства не превышает "300 000 руб
"Нет в реестре массовых руководителей"
"Чистая прибыль" 1 814 тыс. руб »
Категорий GREEN у вас 10. Что к чему должно соотносится? И это только 4 строчки...

[Elizavetta]

okshef, я Вас поняла
Green

Нет дел о банкротстве
Размер непогашенного платежа
Выручка
Нет в реестре массовых руководителей
Нет дисквалифицированных лиц
Выиграны госконтракты
Размещены госконтракты
Нет в реестре недобросовестных поставщиков

Red

Чистый убыток
Внеплановые проверки
Нарушение по проверкам


Grey
Ответчик
Истец
Задолженность по исп.производствам
Плановые проверки
В реестре операторов персональных данных
Нет в реестре малого и среднего бизнеса



пример
https://gyazo.com/eae544e864ac5ddbc407b90f18ddff77

[a_axe]

Но проблема в том, что они идут неструктурировано
наппример для одной компании "Чистая прибыль" в столбце green1, а для другой в green2. »
Elizavetta, если я правильно принимаю ваш вопрос, то проблема состоит в следующем:
Определенные типовые словосочетания раскиданы в произвольном порядке по столбцам, а вам нужно чтобы они были в одном конкретном столбце. Исхожу из предположения, что каждая строчка соответствует одной организации.
Соответственно, хотите вы получить, судя по словам
Можно ли каждую такую категорию встроить в отдельный столбец и переписать туда значения, но чтобы согласовались наблюдения »
правее таблицы еще один дополнительный столбец, в который будут записываться значения ячейки, которая содержит текст из вашего перечня.

Например: ищем в строчке номер 1 фразу "Выручка" плюс некий текст после, если фраза в этой строчке есть - записываем найденное значение ячейки в этот столбец.

Если задача такая, то решается она следующим образом (для вашего выложеного примера): в ячейку AT1 вбейте фразу "Выручка" без кавычек.
В ячейку AT3 вбейте формулу =ЕСЛИОШИБКА(ИНДЕКС(A3:AS3;1;ПОИСКПОЗ($AT$1 & "*";A3:AS3;0));"") и протяните ее ниже.
Если фразы в данной строчки нет, ячейка будет пустой, если фраза в данной строчке есть - в столбец AT будет вписано значение ячейки текущей строки, начинающейся с этого текста, включая и последующий текст, т.е. "Выручка 114 572 тыс. руб" и т.п.
Для каждой фразы делаете аналогичный столбец, и так в нужном вам порядке.

[Elizavetta]

a_axe,
вот этот код помог :)

Sub ResortAttributesGreenGreyRed()

'отключение ненужных функций для ускорения работы макроса
'Prepare
'Объявление переменных
Dim ilr, ilColmn, countaa As Long
Dim CategoriesArr, TempArr As Variant
Dim wb1, wb2 As String
wb1 = ActiveWorkbook.Name
'Определение последнего столбца и строки
ilColmn = Sheets(2).Cells(4, Columns.Count).End(xlToLeft).Column
countaa = ilColmn / 2
ReDim CategoriesArr(1 To countaa, 1 To 6)
For i = 2 To ilColmn Step 2
CategoriesArr(i / 2, 1) = Sheets(2).Cells(1, i).Interior.Color
CategoriesArr(i / 2, 2) = Sheets(2).Cells(Rows.Count, i).End(xlUp).Row - 1
CategoriesArr(i / 2, 6) = Sheets(2).Cells(1, i - 1).Value
Next i

'Окно выбора файла
Application.Dialogs(xlDialogOpen).Show
wb2 = ActiveWorkbook.Name
ilr = Cells(Rows.Count, 2).End(xlUp).Row
ilColmn = Cells(1, Columns.Count).End(xlToLeft).Column
'Определение ключевых столбцов
For k = 1 To countaa
For i = 1 To ilColmn
If Cells(1, i).Interior.Color = CategoriesArr(k, 1) Then
If CategoriesArr(k, 3) = Empty Then
CategoriesArr(k, 3) = i
Else
If Cells(1, i + 1).Interior.Color <> CategoriesArr(k, 1) Then
CategoriesArr(k, 4) = i
End If
End If
End If
Next i
CategoriesArr(k, 5) = CategoriesArr(k, 4) - CategoriesArr(k, 3) + 1
Next k
'копируем лист
Sheets(1).Copy After:=Sheets(1)
Sheets(2).Select
Sheets(2).Name = "Result"
'Добавляем результирующие столбцы
For k = countaa To 1 Step -1
For i = 1 To CategoriesArr(k, 2)
Columns(CategoriesArr(1, 3)).Select
Selection.Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(1, CategoriesArr(1, 3)).Value = CategoriesArr(k, 6) & CategoriesArr(k, 2) - i + 1
Cells(1, CategoriesArr(1, 3)).Interior.Color = CategoriesArr(k, 1)
Next i
Next k
'определяем сдвиг после добавления стобцов
Dim sdvig As Integer
For Z = 1 To countaa
sdvig = sdvig + CategoriesArr(Z, 2)
Next Z
'корректируем границы исходных категорий после добавления стобцов
For Z = 1 To countaa
CategoriesArr(Z, 3) = CategoriesArr(Z, 3) + sdvig
CategoriesArr(Z, 4) = CategoriesArr(Z, 4) + sdvig
Next Z
Dim tempInt As Integer
'запись в массив и обработка элементов по категориям
tempInt = CategoriesArr(1, 3) - sdvig
For i = 2 To countaa * 2 Step 2
ReDim TempArr(1 To CategoriesArr(i / 2, 2))
TempArr = Range(Workbooks(wb1).Sheets(2).Cells(2, i), Workbooks(wb1).Sheets(2).Cells(CategoriesArr(i / 2, 2) + 1, i))
For k = CategoriesArr(i / 2, 3) To CategoriesArr(i / 2, 4)
For Z = 2 To ilr
For T = 1 To CategoriesArr(i / 2, 2)
If InStr(1, Cells(Z, k).Value, TempArr(T, 1)) > 0 Then
Cells(Z, tempInt - 1 + T).Value = Cells(Z, k).Value
End If
Next T
Next Z
Next k
tempInt = tempInt + CategoriesArr(i / 2, 2)
Next i

'Удаляем исходные столбцы

Range(Columns(CategoriesArr(1, 3)), Columns(CategoriesArr(countaa, 4))).Delete




Ended
End Sub

Public Sub Prepare()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False
End Sub

Public Sub Ended()
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True
End Sub