gorogankin (Все сообщения пользователя)

Сбор данных с нескольких таблиц при определенных условиях. Не выводить повторяющиеся элементы

gorogankin Пользователь Сообщений: 43 Регистрация: 04.10.2019	# 14.12.2020 17:50:19 vikttur, Упростить макрос, убрать повторяющиеся элементы
	Перейти

Сбор данных с нескольких таблиц при определенных условиях. Не выводить повторяющиеся элементы

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

14.12.2020 17:25:07

Доброго дня товарищи, я новичок в vba, делаю почти все методом проб и ошибок, наваял код, но он какой-то прямо громоздкий получается, помогите упростить макрос:

Код

Sub rrrr()

For con1 = 3 To 50
Set dtime = ThisWorkbook.Worksheets("Эфирная сетка").Cells(con1, 2)
Set dname = ThisWorkbook.Worksheets("Эфирная сетка").Cells(con1, 4)
Set ddat = ThisWorkbook.Worksheets("Эфирная сетка").Cells(1, 2)

gh = (ThisWorkbook.Worksheets("Лист4").UsedRange.Row - 1 + ThisWorkbook.Worksheets("Лист4").UsedRange.Rows.Count) + 1
Set wdat = ThisWorkbook.Worksheets("Лист4").Cells(gh, 1)
Set wtime = ThisWorkbook.Worksheets("Лист4").Cells(gh, 2)
Set wname = ThisWorkbook.Worksheets("Лист4").Cells(gh, 3)
Set ganr = ThisWorkbook.Worksheets("Лист4").Cells(gh, 4)
Set wvoz = ThisWorkbook.Worksheets("Лист4").Cells(gh, 5)
Set wanot = ThisWorkbook.Worksheets("Лист4").Cells(gh, 6)

If dtime.Value > 0 Then
   wtime.Value = dtime
   wname.Value = dname
   wdat.Value = ddat.Value
i = dname
j = Application.Match(i, [Название], 0)
wvoz.Value = Application.Index([ОписаниеПрограмм], j, 2)
ganr.Value = Application.Index([ОписаниеПрограмм], j, 3)
wanot.Value = Application.Index([ОписаниеПрограмм], j, 4)

End If
Next con1

For con2 = 3 To 50
Set dtime = ThisWorkbook.Worksheets("Эфирная сетка").Cells(con2, 8)
Set dname = ThisWorkbook.Worksheets("Эфирная сетка").Cells(con2, 10)
Set ddat = ThisWorkbook.Worksheets("Эфирная сетка").Cells(1, 8)

gh = (ThisWorkbook.Worksheets("Лист4").UsedRange.Row - 1 + ThisWorkbook.Worksheets("Лист4").UsedRange.Rows.Count) + 1
Set wdat = ThisWorkbook.Worksheets("Лист4").Cells(gh, 1)
Set wtime = ThisWorkbook.Worksheets("Лист4").Cells(gh, 2)
Set wname = ThisWorkbook.Worksheets("Лист4").Cells(gh, 3)
Set ganr = ThisWorkbook.Worksheets("Лист4").Cells(gh, 4)
Set wvoz = ThisWorkbook.Worksheets("Лист4").Cells(gh, 5)
Set wanot = ThisWorkbook.Worksheets("Лист4").Cells(gh, 6)

If dtime.Value > 0 Then
   wtime.Value = dtime
   wname.Value = dname
   wdat.Value = ddat.Value
i = dname
j = Application.Match(i, [Название], 0)
wvoz.Value = Application.Index([ОписаниеПрограмм], j, 2)
ganr.Value = Application.Index([ОписаниеПрограмм], j, 3)
wanot.Value = Application.Index([ОписаниеПрограмм], j, 4)


End If
Next con2

End Sub

Дело в том что таких циклов у меня будет 7, и во всех циклах вот этот код повторяется:

Код

gh = (ThisWorkbook.Worksheets("Лист4").UsedRange.Row - 1 + ThisWorkbook.Worksheets("Лист4").UsedRange.Rows.Count) + 1
Set wdat = ThisWorkbook.Worksheets("Лист4").Cells(gh, 1)
Set wtime = ThisWorkbook.Worksheets("Лист4").Cells(gh, 2)
Set wname = ThisWorkbook.Worksheets("Лист4").Cells(gh, 3)
Set ganr = ThisWorkbook.Worksheets("Лист4").Cells(gh, 4)
Set wvoz = ThisWorkbook.Worksheets("Лист4").Cells(gh, 5)
Set wanot = ThisWorkbook.Worksheets("Лист4").Cells(gh, 6)

If dtime.Value > 0 Then
   wtime.Value = dtime
   wname.Value = dname
   wdat.Value = ddat.Value
i = dname
j = Application.Match(i, [Название], 0)
wvoz.Value = Application.Index([ОписаниеПрограмм], j, 2)
ganr.Value = Application.Index([ОписаниеПрограмм], j, 3)
wanot.Value = Application.Index([ОписаниеПрограмм], j, 4)

Спасибо

Перейти

Копировать результат именованных диапазонов одной книги в именованные диапазоны другой книги

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

12.12.2020 15:50:58

Но все же как вот заменить код:

Код
Windows("Реклама.xlsm").Activate Range("RekBl" & a).Copy

На код подобного порядка:

Код
Range("[Эфир.xlsm]Сетка!C925")

Смысл какой, есть 2 книги:
книга1: там есть 34 именованных диапазона, которые называются: RekBl1, RekBl2, RekBl3 ... RekBl34
в этой книге происходят определенные действия, далее мне просто нужно скопировать результат в 34 именованных диапазона другой книги (в ней таких диапазонов 48), я выбрал вариант циклов так как может быть так что мне нужно будет скопировать RekBl1 книги 1 в RekBl1 книги 2, а может быть так получится что мне нужно будет скопировать со сдвигом, ну то есть RekBl1 первой книги в RekBl10 второй книги и так по порядку (ну то есть 1 в 10, 2 в 11, 3 в 12 и тд), при этом между этими именованными диапазонами в книге 2 есть еще другие заняты информацией ячейки...... не знаю насколько понятно объяснил но как-то так. В общем все что я наваял выше оно работает как мне нужно, просто я хотел немного упростить макрос.

Перейти

Копировать результат именованных диапазонов одной книги в именованные диапазоны другой книги

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

12.12.2020 04:09:35

Юра1987, почему неправильно? Это то как раз таки работает. Мне нужно было в отдельной ячейке вписывать цифру, чтобы происходил сдвиг относительно блоков, например RekBl1 из первой книги копировался в RekBl2 из второй книги если в этой ячейке задана цифра 1. Все работает, я просто хотел немного упростить код. Сейчас работает вот такой код:

Код

Sub Макрос2()
For a = 1 To 34
Windows("Реклама.xlsm").Activate
Range("RekBl" & a).Copy
Windows("Эфир.xlsm").Activate
Set b = Range("[Эфир.xlsm]Сетка!C925")
Range("RekBl" & a + b).PasteSpecial Paste:=xlPasteValues
Next a
End Sub

имя листа в моем случае писать не нужно, зачем? Я же пояснил выше что объекту присвоено имя в рамках книги, зачем для этого усложнять и вставлять название листа?

Перейти

Копировать результат именованных диапазонов одной книги в именованные диапазоны другой книги

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

12.12.2020 03:26:41

книги разные...

Код

Sub CopPast_Rekl() 'пока не пашет
For a = 1 To 34
Workbooks("Реклама").Range("RekBl" & a).Copy
Set b = Range("[Эфир.xlsm]Сетка!C925")
Workbooks("Эфир").Range("RekBl" & a + b).PasteSpecial Paste:=xlPasteValues
Next a
End Sub

Перейти

Копировать результат именованных диапазонов одной книги в именованные диапазоны другой книги

gorogankin Пользователь Сообщений: 43 Регистрация: 04.10.2019	# 12.12.2020 03:23:47 Юра1987, не работает....
	Перейти

Копировать результат именованных диапазонов одной книги в именованные диапазоны другой книги

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

12.12.2020 03:02:40

Цитата
Юра1987 написал: Лист1

Доброго дня, спасибо, а лист обязательно писать? Ведь именнованный диапазон он ко всей книге привязан

Перейти

Копировать результат именованных диапазонов одной книги в именованные диапазоны другой книги

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

12.12.2020 02:15:51

Всем доброго дня. Прошу помощи с синтаксисом в VBA, у меня 2 открытые книги, я через цикл копирую из одной книги в другую именованный блок ячеек, ну то есть у меня несколько блоков ячеек, которым присвоено имя RekBl1, RekBl2 и тд, "a" - это цифра цикла от 1 до 34.

Код
Range("[Реклама.xlsm]("RekBl" & a)").Copy

Перейти

Макрос Копировать вставить значения по цвету ячейки

gorogankin Пользователь Сообщений: 43 Регистрация: 04.10.2019	# 17.07.2020 15:58:34 msi2102, да, невнимательно прочитал, спасибо еще раз большое за реализацию, очень сильно выручили
	Перейти

Макрос Копировать вставить значения по цвету ячейки

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

17.07.2020 13:47:13

msi2102, пробовал выдает ошибку
то есть если написать вот так, то норм:

Код
Range("I6:I138").Select Set Ran = Selection

а если, вот как ниже, то пишет ошибку:

Код
Set Ran = Range("I6:I138").Select

Перейти

Макрос Копировать вставить значения по цвету ячейки

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

17.07.2020 12:35:38

msi2102, я вообщем разобрался, просто добавил в макрос вот этот код

Код
Range("i6", Range("i138").End(xlUp)).Select

Перейти

Макрос Копировать вставить значения по цвету ячейки

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

17.07.2020 12:22:19

msi2102, Добрый день, да работает идеально, ну то есть результат выдает как нужно, огромное спасибо.

Ток один момент, а нельзя все таки задать вместо выделения диапазона, начальную и конечную точки диапазона, ну то есть как я писал, начало и конец они известны

Перейти

Макрос Копировать вставить значения по цвету ячейки

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

16.07.2020 21:08:44

Цитата
Юрий М написал: показать Было - стало никак? замените файл.

Дело в том, что картинками я прислал не "было-стало", а вариации, как могут располагаться ячейки их бесчисленное множество, это только 2 вариации, ну то есть диапазон желтых-зеленых это как раз динамичный диапазон. На одном листе он может быть как на первой картинке, на втором листе как на второй и это еще не конечный вариант.

Еще раз попробую объяснить смысл всего действа:
Есть некоторая таблица где некоторое количество желтых ячеек заполняются макросом автоматически по принципу такому (столбец всегда один и тот же), а количество желтых строк с пропусками (с прозрачными ячейками) и с ячейками другого цвета (в них формулы, которые трогать нельзя). Так вот он заполняет все желтые ячейки определенными числами, но вот ниже желтых есть зеленые ячейки, в которых будет повторятся все что есть в желтых, по кругу. Как на картинке ниже.
Ну то есть столбец будет содержать несколько блоков (с желтыми ячейками, в которых количество этих желтых ячеек одинаково, но может варьироваться, ну то есть сейчас это 7 строк, но может быть и 6, а может быть 8 ). Но количество ячеек в блоке зеленом всегда будет равно количеству ячеек в блоке желтом. Но вот блоков желтых и зеленых может быть разное количество, в одном файле желтых может быть 2, а зеленый всего 1, на втором листе желтых может быть 4, а зеленых 8. Единственное что хочу сказать что итоговое количество желтых + зеленых блоков всегда будет одинаково и равно 12, но мне в некоторых листах не потребуется столько ячеек и я просто ручками сделаю например 1 и 2 блоки желтыми, а 3 зеленым, а другие просто обесцвечу, поэтому я взял за принцип заполняемость ячеек по цвету ячейки.

Цитата
Михаил Витальевич С. написал: и еще- желтые и зеленые ячейки находятся в заранее известных диапазонах?

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

Код
For a = 3 To 33 Set b = ActiveSheet.Cells(a, 9) Set d = ActiveSheet.Cells(c, 9)

я поэтому и оформляю for именно так, ну то есть 3 - это 3 строка на листе начало общего диапазона, а 33 конец, а цифра 9 это как раз таки 9 столбец (но я в итоговом макросе могу изменить эти параметры, это же макрос пример).

Я не знаю может как вариант я хотел попроще, может вот всем 12 блокам присвоить имя? и тогда будет копироваться четко весь поименный блок желтый, в в весь поименный блок зеленый.

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

Перейти

Макрос Копировать вставить значения по цвету ячейки

gorogankin Пользователь Сообщений: 43 Регистрация: 04.10.2019	# 16.07.2020 17:54:59 Во вложении скрины картинок что должно быть. Изменено: gorogankin - 16.07.2020 17:56:51
	Перейти

Макрос Копировать вставить значения по цвету ячейки

gorogankin Пользователь Сообщений: 43 Регистрация: 04.10.2019	# 16.07.2020 03:19:59 Прошу прощение, во вложении таблица с макросом
	Перейти

Макрос Копировать вставить значения по цвету ячейки

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

16.07.2020 02:23:05

Добрый день. Коллеги, я не разбираюсь в VBA от слова совсем. Но кое что со стряпал, огромная просьба помочь разобраться.
Вообщем задача такая в таблице друг под другом есть столбец желтых ячеек (цвет: 65535) и столбец зеленых ячеек (цвет: 5296274) есть задача скопировать только результат из желтых ячеек в зеленые последовательно, причем между желтыми и зелеными ячейками могут быть ячейки другого цвета и количество желтых и зеленых ячеек может быть разным. Задача чтобы получилось примерно так: желтые 1,2,3,4,5 зеленые: 1,2,3,4,5,1,2 (ну то есть если зеленых больше то копирование было бы по кругу).

Я наваял макрос ниже, но он что делает, проходит по желтым ячейкам и результат из 1 желтой ячейки он копирует во все зеленые, потом результат из второй ячейки во все зеленые и так пока не пройдет все желтые..... Буду очень благодарен помощи или совету

Код

Sub copYel() 'копирование из желты в зел
 For a = 3 To 33
 For c = 3 To 33
 Set b = ActiveSheet.Cells(a, 9)
 Set d = ActiveSheet.Cells(c, 9)
 If b.Interior.Color = 65535 Then
 b.Copy
 If d.Interior.Color = 5296274 Then d.PasteSpecial xlPasteValues
 End If
 Next c
 Next a
 End Sub

Перейти

Экспорт в txt в формате "типа" html

gorogankin Пользователь Сообщений: 43 Регистрация: 04.10.2019	# 28.11.2019 22:07:07 Всем спасибо за помощь, вопрос решен.
	Перейти

Экспорт в txt в формате "типа" html

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

28.11.2019 20:18:10

doober, я понимаю что нужно что-то подправить здесь, а что подправить и как вообще не понимаю

, помогите, пожалуйста:

Код

For i = LBound(arrData) To UBound(arrData)
' создание нового узла
Set xmlFields = xmlDoc.DocumentElement.appendChild(xmlDoc.createElement("Element"))
    xmlFields.setAttribute "", ""

For j = LBound(arrHeaders) To UBound(arrHeaders) ' добавление полей в узел
Set xmlField = xmlFields.appendChild(xmlDoc.createElement(Replace(arrHeaders(j), " ", "_")))
xmlField.Text = arrData(i, j + LBound(arrData, 2) - LBound(arrHeaders))
Next j
Next i

Перейти

Экспорт в txt в формате "типа" html

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

28.11.2019 19:41:10

Я еще попробовал стандартными средствами эксель экспортивоть в mxl, все хорошо, но затык именно в этой части элемента:

<Field Name="Подпись">тут будет текст</Field>

Если удаляю его, то выгрузка стандартным средством эксель получается и файл моей программой читается, но вот не задача, мне нужно чтобы этот элемент обязательно присутствовал, мало того их может быть несколько подряд. А с ним программа не дает экспортировать, пишет оишбка.

Перейти

Экспорт в txt в формате "типа" html

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

28.11.2019 18:42:12

doober, добрый день, да, вы действительно правы, я сейчас в тест-файлике удалил все пробелы и программа его схавала. Я просто далеко не спец не в xml не в VBA, поэтому просто смотрю визуально. Сама программа просто сохраняет файл с пробелами, я поэтому и подумал что это важно.

Цитата
doober написал: Вы попутали некоторые элементы и свойства элементов

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

Перейти

Экспорт в txt в формате "типа" html

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

28.11.2019 14:50:55

С этим я разобрался, кроме пробелов:

Цитата
gorogankin написал: 1 уровень был <TSLibrary>, а он сохраняет <Root>

Во вложении измененный файл

Изменено: gorogankin - 28.11.2019 14:51:46

Перейти

Экспорт в txt в формате "типа" html

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

28.11.2019 14:27:50

Я нашел примерное решение вопроса. Во вложении файл, но он сохраняет не совсем как мне нужно.
Нужно чтобы:
1) 1 уровень был <TSLibrary>, а он сохраняет <Root>, потом после <TSLibrary> должен быть один пробел
2) <Element Filename="F:\TITR\удалить.tpj" StartDate="28.11.2019"..... - то есть данные должны быть внутри заголовка второго уровня и они должны быть вида: Заголовок="Текст из таблицы".
3) Насколько я понял: <Field Name="Подпись">тут будет текст</Field> и перед ним должно быть уже 2 пробела - это уже заголовок 3-го уровня, и как это реализовать я не знаю....

Игорь, может посмотрите?

Други очень прошу помощи, спасибо. Я совсем не шарю не в xml коде не в макросах, так методом визуального втыка пытаюсь экспериментировать....

Изменено: gorogankin - 28.11.2019 14:33:51

Перейти

Экспорт ячейки в txt, по времени, указанному в другой заданной ячейке

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

28.11.2019 11:27:07

Цитата
МатросНаЗебре написал: сориентируйте в каком направлении хотите продолжать. Нужна ли Вам помощь при реализации через VBA?

Добрый день. Да я вот думаю зайти с совсем с другого направления, может быть проще будет. Если в кратце, то у меня программа выпуска на эфире и программа титров, плейлист по автоматизации составления расписания для эфира видео я уже (общими усилиями) наваял, осталось наваять решение по титрам, только там расписание идет в виде xml кода, я создал тему: https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=123218&TITLE_SEO=123218-eksport-v-txt-v-formate-tipa-html сейчас попробую в этом направлении подвигаться.

Перейти

Экспорт в txt в формате "типа" html

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

28.11.2019 11:20:59

Цитата
Игорь написал: Ищите макросы для экспорта из Excel в XML (макросы для создания XML по таблице Excel)

Спасибо за подсказку, я просто не совсем в теме, играюсь методом тыка так сказать, искал именно по тегу HTML и находил все не то, сейчас попробую поискать

Перейти

Экспорт в txt в формате "типа" html

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

28.11.2019 05:15:41

Добрый день. Попробую в последний раз обнаглеть и обратиться с просьбой помощи в бесплатном разделе форума.... Буду благодарен помощи.

Задача состоит в том, чтобы выгрузить в txt файл таблицу (желательно указать конкретный лист, так как листов в книге будет много) в виде xml version="1.0" , то есть насколько я понимаю это не стандартный код. Вообщем названия столбцов в таблице, это заголовки. Выгрузка должна быть в формате: xml version="1.0" encoding="UTF-8". Пары столбцов IJ и KL имеют одинаковые заголовки, если данные в одной паре (например KL в первой строчке) или во всех парах отсутствуют, то соответственно и данный текст должен отсутствовать "<Field Name="Еще">хххххххххххххххх</Field>"
Пример как выглядит таблица exel и txt во вложении.

Заранее большое спасибо.

Изменено: gorogankin - 28.11.2019 12:38:35

Перейти

Экспорт ячейки в txt, по времени, указанному в другой заданной ячейке

gorogankin Пользователь Сообщений: 43 Регистрация: 04.10.2019	# 28.11.2019 04:45:14 БМВ, спасибо большое буду изучать
	Перейти

Экспорт ячейки в txt, по времени, указанному в другой заданной ячейке

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

27.11.2019 22:33:44

МатросНаЗебре, Юрий М
я заметил такой момент если время вводишь прошедшее, то при запуске макроса ничего не происходит. А если время пишешь будущее, ну которое еще должно наступить относительно текущего времени, то выводится ошибка, которую я написал выше.

Перейти

Экспорт ячейки в txt, по времени, указанному в другой заданной ячейке

gorogankin Пользователь Сообщений: 43 Регистрация: 04.10.2019	# 27.11.2019 18:54:52 Юрий М, во вложении пример. Спасибо Изменено: gorogankin - 27.11.2019 18:55:07
	Перейти

Экспорт ячейки в txt, по времени, указанному в другой заданной ячейке

gorogankin Пользователь Сообщений: 43 Регистрация: 04.10.2019	# 27.11.2019 18:07:37 МатросНаЗебре, сейчас еще раз все перепроверил, перезаполнил на будущее время, сохранил, запускаю макрос пишет вот что: Run-time error '13': Type mismatch?
	Перейти

Экспорт ячейки в txt, по времени, указанному в другой заданной ячейке

Пользователь

Сообщений: 43 Регистрация: 04.10.2019

27.11.2019 18:03:06

Цитата
МатросНаЗебре написал: Нужно заполнить диапазон ("A1:B3").

это само собой, заполнил

Цитата
МатросНаЗебре написал: В столбце А дата и время

формат ячейки с датой и временем: "ДД.ММ.ГГГГ чч:мм:сс" верно?

если так, то ничего не происходит((

Перейти

Наверх