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

[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, чтобы выполнить задачу, нужно знать ВСЕ возможные критерии соотнесения событий к категориям и подкатегориям. Вот ваш текст


Цитата Elizavetta:



Каждая категория имеет подкатегории

например для green

"Чистая прибыль" 1 458 тыс. руб

"Размер непогашенного обязательства не превышает "300 000 руб

"Нет в реестре массовых руководителей"

"Чистая прибыль" 1 814 тыс. руб

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

Категорий GREEN у вас 10. Что к чему должно соотносится? И это только 4 строчки...

[Elizavetta]

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

Green



Нет дел о банкротстве

Размер непогашенного платежа

Выручка

Нет в реестре массовых руководителей

Нет дисквалифицированных лиц

Выиграны госконтракты

Размещены госконтракты

Нет в реестре недобросовестных поставщиков



Red



Чистый убыток

Внеплановые проверки

Нарушение по проверкам





Grey

Ответчик

Истец

Задолженность по исп.производствам

Плановые проверки

В реестре операторов персональных данных

Нет в реестре малого и среднего бизнеса







пример

https://gyazo.com/eae544e864ac5ddbc407b90f18ddff77

[a_axe]

Цитата Elizavetta:



Но проблема в том, что они идут неструктурировано

наппример для одной компании "Чистая прибыль" в столбце green1, а для другой в green2.

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

Elizavetta, если я правильно принимаю ваш вопрос, то проблема состоит в следующем:

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

Соответственно, хотите вы получить, судя по словам


Цитата Elizavetta:



Можно ли каждую такую категорию встроить в отдельный столбец и переписать туда значения, но чтобы согласовались наблюдения

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

правее таблицы еще один дополнительный столбец, в который будут записываться значения ячейки, которая содержит текст из вашего перечня.



Например: ищем в строчке номер 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