gorogankin (Автор тем)

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

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

Сообщений: 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)

Спасибо

Перейти

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

gorogankin

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

Сообщений: 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

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 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

27.11.2019 11:22:28

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

Например есть таблица:
А B
27.11.2019 14:00 1
27.11.2019 15:00 2
27.11.2019 16:00 3

Макрос бы обрабатывал заданную таблицу, и в указанный момент времени в столбце А записывал бы в тектовый документ значение из строки, соответствующей времени в столбце B, не друг за другом, а заменялся бы, то есть с наступлением времени "1", менялось бы на "2" и тд

Прошу прощение за казусы в VBA совсем не разбираюсь)

Перейти

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

gorogankin

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

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

22.11.2019 13:32:43

Всем добрый день! Совсем не разбираюсь в VBA, пытаюсь ковыряться методом втыка. Прошу помощи.
Задача такая. Есть 2 умные таблицы, одна общая со всеми данными, во вторую я хочу помещать результаты выборки нажав кнопку с макросом, макрос ниже, но дело в том что если я делаю отбор по одному значению и нажимаю на макрос у меня во вторую таблицу копируется не результат отбора, а вся первая таблица... Подсскажите что изменить в коде чтобы копировался именно результат отбора первой таблицы (общий). И важно чтобы в таблице "общий3" перед копированием старая информация стиралась.

Спасибо.

Код
Sub CopyRange4() Range("общий").Copy Range("общий3") End Sub

Изменено: gorogankin - 22.11.2019 13:36:24

Перейти

Генерирование случайного числа до получения нужного результата

gorogankin

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

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

27.10.2019 20:10:07

Добрый вечер! Форумчане помогите разобраться, я пример взял из уже обсуждаемой темы, немного доработал под себя, ток у меня не получается. Заранее спасибо за помощь.

Задача такая: Сначала я генерирую случайное число в ячейку С1 с помощью кнопки (это работает), далее мне нужно чтобы в ячейке C1 генерировалось случайное число с помощью макроса GetRandom5, если выполняется условие "Да" в ячейке A1.
Ну то есть мне нужно примерно так: сначала я ручками генерирую случайное число, потом формулой если это случайное число будет сверено со значением в другой таблице (это я сам потом допилю), и если допустим как в примере вычисление по формуле даст результат да, то случайное число заново сгенерировалось и так по кругу, пока не добьюсь нужного результата.

Код

Sub GetRandom5()
    Randomize
    ThisWorkbook.Worksheets("Лист1").Range("C1").value = Int((654 * Rnd) + 1)
End Sub

Sub Worksheet_Calculate()
    If ThisWorkbook.Worksheets("Лист1").Range("A1").value = "Да" Then GetRandom5
End Sub

Изменено: gorogankin - 28.10.2019 00:18:08

Перейти

Экспорт в .txt определенного диапазона по заданным условиям

gorogankin

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

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

07.10.2019 12:08:36

Добрый день. Форумчане, прошу о помощи, я в VBA совсем не разбираюсь, формулы только немного освоил, и то каряво. Вообщем есть задача выводить в txt заданный диапазон, например E3:P18 (чтобы было не выделением, а именно диапазон был прописан в макросе, чтобы я ручками потом его смог поменять) и еще 3 важных условия: чтобы экспорт сохранял табуляцию, чтобы при экспорте он выкидывал пустые строки (по заданному диапазону) и строки где в столбце "К" есть показание "00:00:00:00".
Во вложении таблица, а также пример, который должен получится в txt. Буду очень благодарен, еще раз спасибо.

Перейти