[решено] распределение по столбцам - Компьютерный форум OSzone.net

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Microsoft Office (Word, Excel, Outlook и т.д.) (http://forum.oszone.net/forumdisplay.php?f=115)

- - [решено] распределение по столбцам (http://forum.oszone.net/showthread.php?t=328177)

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

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

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

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 есть другие колонки).

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

Elizavetta, чтобы выполнить задачу, нужно знать ВСЕ возможные критерии соотнесения событий к категориям и подкатегориям. Вот ваш текст

Цитата:

Цитата Elizavetta

Каждая категория имеет подкатегории
например для green
"Чистая прибыль" 1 458 тыс. руб
"Размер непогашенного обязательства не превышает "300 000 руб
"Нет в реестре массовых руководителей"
"Чистая прибыль" 1 814 тыс. руб »

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

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

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

Red

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

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

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

Цитата:

Цитата Elizavetta

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

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

Цитата:

Цитата Elizavetta

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

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

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

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

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