Добрый день. Не знаю как правильно назвать тему. Вопрос вот в чем. Выгружаю данный из SQL. Копирую в эксель , получается набор Районов , выбор трека и количество. Мне нужно из этого получить таблицу, которую я приложил 2-ую. Объяснить сложно, легче посмотреть и поймете что необходимо. Книга 1 - выгрузка из Эксель Общий отчет - то что нужно получить.
Я сейчас выгружаю из эксель и потом вручную проставляю по колонкам, реально ли это сделать автоматом ? Колонка Трек. там 10 возможных данных. Вот их расставить на 10 колонок и подставить данные. Тем самым убрав дубли с районов, что систематизирует таблицу и уменьшит соответственно количество строчек.
Попробовал в файле общий отчет. в данные к примеру по треку "Бизнес" подставить формулу ЕСли... и сравнивал если название колонки ровно названию в той таблице И название района ровно названию в той таблице ТО подставляем значение из той таблицы... не не получается... при протягивании все сбивается... Или вообще в неправильном направлении думал ?
linky, из названия темы абсолютно непонятна задача. Предложите новое - модераторы поменяют. И приведите в порядоке стартовое сообщение: зачем в нём столько пустых строк? Зачем так растягивать сообщение? Читабельность от этого лучше не становится.
но так как Вы грузите из бд, то лучше тянуть и таблицу фактов и справочники, собрать в модель (power pivot) и оттуда уже сводные делать. Тогда не надо будет ваших бесконечных ЕСЛИ (что будет, если у вас этих треков, не 29, а 100? на все условия с ЕСЛИ писать?) По power pivot много инфы в нете, и здесь, и книги есть.
let
Источник = Excel.Workbook(File.Contents(Excel.CurrentWorkbook(){[Name="Файл"]}[Content][Файл]{0}), null, true),
Лист1_Sheet = Источник{[Item="Лист1",Kind="Sheet"]}[Data],
#"Повышенные заголовки" = Table.PromoteHeaders(Лист1_Sheet, [PromoteAllScalars=true]),
#"Другие удаленные столбцы" = Table.SelectColumns(#"Повышенные заголовки",{"МО", "Трек ID", "количество"}),
#"Сведенный столбец" = Table.Pivot(Table.TransformColumnTypes(#"Другие удаленные столбцы", {{"Трек ID", type text}}, "ru-RU"), List.Distinct(Table.TransformColumnTypes(#"Другие удаленные столбцы", {{"Трек ID", type text}}, "ru-RU")[#"Трек ID"]), "Трек ID", "количество", List.Sum),
a = List.Zip({{"25","27","20","22","21","26","23","28","29","24"},{"Социальная сфера","Местное самоуправление","Бизнес","Экономика и финансы","Архитектура и строительство","Спорт и военная подготовка","Комфортная среда","Индустрия гостеприимства","Инфотех","Сельское хозяйство"}}),
#"Переименованные столбцы" = Table.RenameColumns(#"Сведенный столбец",a)
in
#"Переименованные столбцы"
Макрос выбора файла
Код
Sub Файл()
Dim avFiles, lRetVal As Long
avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", 1, "Выбор файла", msoFileDialogViewDetails, False)
If VarType(avFiles) = vbBoolean Or avFiles = "" Then
Exit Sub
End If
ThisWorkbook.Worksheets("Файл").ListObjects("Файл").DataBodyRange(1, 1) = avFiles
DoEvents
ActiveWorkbook.RefreshAll
Sheets("Результат").Select
End Sub
В файле "Книга_11.xlsm" на листе "Файл", жмите кнопочку, выбирайте файл. PS:
Sub transform_table()
Dim dict As Object, arr, key, item, names_arr(), title
Dim i, j, tmp, lr, f
Set dict = CreateObject("Scripting.Dictionary")
title = Array("Муниципальное образование", "Социальная сфера", "Местное самоуправление", _
"Бизнес", "Экономика и финансы", "Архитектура и строительство", _
"Спорт и военная подготовка", "Комфортная среда", "Индустрия гостеприимства", _
"Инфотех", "Сельское хозяйство")
With ThisWorkbook.Worksheets("Лист1")
arr = .Cells(1, 1).CurrentRegion
End With
For i = 2 To UBound(arr, 1)
key = arr(i, 1)
If Not dict.exists(key) Then
dict.Add key, arr(i, 2) & ":" & arr(i, 4)
Else
dict(key) = dict(key) & ";" & arr(i, 2) & ":" & arr(i, 4)
End If
Next i
' выгрузка на лист
With ThisWorkbook.Worksheets("Лист2")
.Cells.Clear
.Cells(1, 1).Resize(1, UBound(title) + 1) = title
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
For Each f In dict.keys()
For j = LBound(title) To UBound(title)
If j = 0 Then
.Cells(lr + 1, 1) = f
Else
item = find_in_dict(dict, title(j), f)
.Cells(lr + 1, j + 1) = item
End If
Next j
lr = lr + 1
Next f
.ListObjects.Add(xlSrcRange, Range("$A$1:$K$60"), , xlYes).Name = _
"Таблица1"
End With
End Sub
Private Function find_in_dict(arr, what, key) As Variant
Dim j, tmp, i, item
find_in_dict = 0
For Each j In arr.keys()
If key = j Then
tmp = Split(arr(j), ";")
For Each i In tmp
item = Split(i, ":")
If item(0) = what Then find_in_dict = item(1): Exit Function
Next i
End If
Next j
End Function