2010 - [решено] Как написать макрос разделения данных на категории

Аватара пользователя
Elizavetta

2010 - [решено] Как написать макрос разделения данных на категории

Сообщение Elizavetta »

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

со столбца А по J находится общая таблица. Мне из нее надо получить несколько таблиц для каждого дерева. Т.е. каждое дерево с его данными с A по J

вывести в отдельную табличку. Со столбца М по АК я показала пример. Сейчас я это делаю руками и очень тяжело. Особенно если огромное множество деревьев.

Если несложно помогите пожалуйста.
Вложения
Копия Книга3.zip
(3.84 КБ) 0 скачиваний
Копия Книга3.zip
(3.84 КБ) 0 скачиваний
Аватара пользователя
megaloman

Re: 2010 - [решено] Как написать макрос разделения данных на категории

Сообщение megaloman »

Elizavetta, Вы владеете фильтром? Загрузите csv в Excel, наложите фильтр и копируйте отфильтрованные данные на другие листы. Пример прилагаю, иначе нужен макрос.
Аватара пользователя
Iska

Re: 2010 - [решено] Как написать макрос разделения данных на категории

Сообщение Iska »

Elizavetta, предлагаю немного другой вариант.

Сохраните код в файл с расширением .vbs:

Скрытый текст

[spoiler]Код:
[/spoiler]

Код: Выделить всё

Option Explicit
Const xlFilterCopy = 2
Dim strSourceFile
Dim objFSO
Dim objExcel
Dim objThisWorksheet
Dim objNewWorksheet
Dim objRange
Dim objDictionary
Dim arrKeys
Dim i
If WScript.Arguments.Count = 1 Then
	Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
	strSourceFile = objFSO.GetAbsolutePathName(WScript.Arguments.Item(0))
	If objFSO.FileExists(strSourceFile) Then
		Set objExcel         = WScript.CreateObject("Excel.Application")
		Set objThisWorksheet = objExcel.Workbooks.Open(strSourceFile).Worksheets.Item("исходные данные")
		With objThisWorksheet
			Set objDictionary = WScript.CreateObject("Scripting.Dictionary")
			Set objNewWorksheet = .Parent.Worksheets.Add()
			.UsedRange.Columns(3).Cells.AdvancedFilter xlFilterCopy, , objNewWorksheet.Cells(1), True
			For i = 2 To objNewWorksheet.UsedRange.Rows.Count
				objDictionary.Add objNewWorksheet.Cells(i, 1).Value, 0
			Next
			objExcel.DisplayAlerts = False
			objNewWorksheet.Delete
			objExcel.DisplayAlerts = True
			Set objNewWorksheet = Nothing
			arrKeys = objDictionary.Keys
			For i = UBound(arrKeys) To LBound(arrKeys) Step -1
				.UsedRange.AutoFilter 3, arrKeys(i)
				CopyRange2NewWorksheet .Parent.Worksheets.Add(, objThisWorksheet), arrKeys(i), .UsedRange
			Next
			objDictionary.RemoveAll
			Set objDictionary = Nothing
			.ShowAllData
			.AutoFilterMode = False
			.Select
		End With
		objExcel.Visible = True
		Set objThisWorksheet = Nothing
		Set objExcel         = Nothing
	Else
		WScript.Echo "Can't find source file [" & strSourceFile & "]."
		WScript.Quit 2
	End If
	Set objFSO = Nothing
Else
	WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ "
	WScript.Quit 1
End If
WScript.Quit 0
'=============================================================================
'=============================================================================
Sub CopyRange2NewWorksheet(objNewWorksheet, strName, objRange)
	With objNewWorksheet
		objRange.Copy .Cells(1)
		.Name = strName
		.Columns.AutoFit
	End With
End Sub
'=============================================================================


Затем просто перетащите на него Ваш файл с Рабочей книгой Excel. Спустя некоторое время Вы должны получить эту Рабочую книгу с несколькими новыми Рабочими листами, согласно уникальных данных из третьего столбца Рабочего листа «исходные данные», наподобие:

Скрытый текст

[spoiler]Изображение[/spoiler]

Дальше Вы можете поступать с этой открытой Рабочей книгой по своему усмотрению.
Аватара пользователя
Iska

Re: 2010 - [решено] Как написать макрос разделения данных на категории

Сообщение Iska »

А я бы тупо просто отсортировал Изображение. Хотя, если действительно «множество» — таки написал бы макрос.
Аватара пользователя
okshef

Re: 2010 - [решено] Как написать макрос разделения данных на категории

Сообщение okshef »

И сводные таблицы никто не отменял. Хоть десяток их сделайте
Аватара пользователя
megaloman

Re: 2010 - [решено] Как написать макрос разделения данных на категории

Сообщение megaloman »

Elizavetta, уточните задачу. У Вас какой исходный файл: csv или xlsx, xls ... и что должно получиться в результате: несколько csv или xlsx.
Аватара пользователя
Elizavetta

Re: 2010 - [решено] Как написать макрос разделения данных на категории

Сообщение Elizavetta »

megaloman, тут csv для маленького примера ,а в жизни будет xlsx



результат должен быть в этом же экселе

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



Макрос нужен, потому что я фильтром и не хочу вручную. Вот отсюда и родилась просьба о макросе. Т.е. то что вы сделали фильтром мне бы макросом автоматом
Аватара пользователя
Elizavetta

Re: 2010 - [решено] Как написать макрос разделения данных на категории

Сообщение Elizavetta »

Iska, если бы было мало деревьев, я бы сама рукамиИзображение

а тут может быть сотни. Поэтому и попросили помочь по возможности, конечно)
Аватара пользователя
Elizavetta

Re: 2010 - [решено] Как написать макрос разделения данных на категории

Сообщение Elizavetta »

Elizavetta, давайте тогда так: упакуйте реальный файл в архив, каковой приложите к сообщению, либо выложите на облако или вменяемый обменик. Расскажите, что значит «вывести в отдельную табличку» — на новый Рабочий лист, в новую Рабочую книгу, и как их правильно именовать (в том варианте, который Вы выберете).
Ответить

Вернуться в «Microsoft Office (Word, Excel, Outlook и т.д.)»