Попробуйте через Union. Еще вероятное улучшение с точки зрения оптимизации кода: - столбцы идут парами - к столбцу можно обращаться и по его номеру - с каждого редактированного листа нумерация столбцов смещается на два
Sub aaaaa()
Dim RR As Range, a&, b&, c&, t$, WB As Workbook, sh As Worksheet, tt$
On Error Resume Next
Set WB = Workbooks("base.xlsx")
tt = WB.Path 'путь для сохранения *csv файла
If Err Then Err.Clear: On Error GoTo 0: Exit Sub 'нет такой книги среди открытых
On Error GoTo 0
On Error Resume Next
Set sh = WB.Sheets("csvdate")
If Err Then Err.Clear: On Error GoTo 0: Exit Sub 'нет такого листа в книге
On Error GoTo 0
a = sh.UsedRange.Row
c = FreeFile
Open tt & "\" & "Test.csv" For Output As #c 'путь + имя файла с расширением
For b = a To a + sh.UsedRange.Rows.Count - 1
t = vbNullString
For Each RR In sh.UsedRange.Rows(b).Cells
t = t & RR.Value & ";"
Next
Print #c, t
Next
Close #c
End Sub
Страсти по Игорю... На мой скромный взгляд тут все на усмотрение модераторов - они тоже на добровольных началах, и без них форум превратится в свалку. Игоря отчасти тоже можно понять: возраст, из каждого утюга на родине льют в уши всякую срань, обстановка мягко говоря нервная, а тут еще тз мутное... В общем понять можно всех, но правила (не обязательно буква в букву) на первом месте.
При конвертации с Excel в HTML (в аутлук можно в качестве тела письма что-то добавить только в этом формате) цвет передаваемый в RGB инвертируется по старшему и младшему байтам (R<>B). Вот и интересно какая там цветовая схема или стандарт используется.
А в Outlook (HTML) какая цветовая схема использована? Помню перегонял RGB, точнее переставлял крайние байты местами в коде цвета при конвертации из экселя в HTML.
Sub aaaa()
Dim RR As Range, RR1 As Range, WBout As Workbook, WBin As Workbook, sh As Worksheet, a&, b&, c&, aa, x&, xx&
Set WBin = ThisWorkbook 'книга, из которой вызывается макрос, она-же приемник
Set WBout = Workbooks("пример_откуда.xlsx") 'книга-донор
aa = Array("а", "б") 'названия листов в обеих книгах)
For a = 0 To UBound(aa)
With WBout.Sheets(aa(a)): b = .Cells(.Rows.Count, "C").End(xlUp).Row: End With
With WBin.Sheets(aa(a)): c = .Cells(.Rows.Count, "C").End(xlUp).Row + 1: End With
With WBout.Sheets(aa(a))
x = 2
Do While x <= b 'шерстим столбец "С" листа на наличие ячеек окрашенных желтым
Do While .Cells(x, "C").Interior.Color <> vbYellow
x = x + 1
Loop
If x > b Then Exit Do
If RR Is Nothing Then
Set RR = Intersect(.UsedRange, .Columns("C:D"), .Rows(x))
Else: Set RR = Union(RR, Intersect(.UsedRange, .Columns("C:D"), .Rows(x)))
End If
x = x + 1
Do While .Cells(x, "C").Interior.Color = vbYellow
Set RR = Union(RR, Intersect(.UsedRange, .Columns("C:D"), .Rows(x)))
x = x + 1
Loop
Loop
End With
If Not RR Is Nothing Then
RR.Copy WBin.Sheets(aa(a)).Cells(c, "C"): Set RR = Nothing
End If
Next
End Sub
На мой взгляд проще отстать от фильтров на листе и написать собственный. Процедура с массивом параметров, где указан номер столбца в таблице, количество фильтрующих масок, и маски фильтров. И т.д.. А в самой процедуре: - обход всех строк содержащих данные - применение фильтров со скрытием отфильтрованных строк и отображением (вдруг они были скрыты ранее) всех остальных - полученный результат уже вставлять в письмо руками или программно
Что имеем: - выгружаемый на форму массив с ограничением по количеству строк и размеру шрифта + массив заголовков (двумерный) - верхняя строка Label's с полезными данными (сразу после заголовков таблицы) - клик на этой строке приводит к скроллингу вверх на одну строку - нижняя строка контролов - скролл на одну строку вниз - клик по любому из заголовку - сортировка всей таблицы по текущей колонке. первый клик - сортировка по возрастанию, второй - по убыванию.
С размером шрифтов особо не экспериментировал, наверняка потребуется настройка процедуры вывода и расчета размеров формы, т.к. там все не так однозначно как хотелось бы. Сортировщики используются текст/числа. Собственно определение типа данных тоже идет в этом ключе, т.е. либо текст, либо число. Если наполнение таблицы будет разношерстными данными в рамках отдельно взятой колонки, то лучше переделать на универсальный сортер - он есть в модуле с процедурами.
Настраиваемый шаг скролла поленился делать)
П.С.: Второй файл скачал из первого поста - все работает. Автору - СПАСИБО!
Изменено: Anchoret - 08.04.2023 00:55:13(Благодарности автору топика)
Евгений Киреев, завтра посмотрю. Там все это дело включено в довольно сложный многопроцедурный код. Нужно время чтобы вычленить нужное без потери его работоспособности)
По идее норм, там опознание разрядности системы 64/32. --------------
Я делал разлинованные таблицы в форме на основе генерируемых Label с прокруткой кликом по верхней/нижней "строке" этой таблицы. Соответственно весь этот выводимый массив меток перезаписывался при таком "скроллинге". Можно настроить шаг скролла. Если нужно, то могу на домашнем компе глянуть. Но там вроде ничего сложного.
-------------------------------------- Котовое колесо заинтересовало. У меня как раз несколько потенциальных генераторов жирком дома обрастает...
Если список одномерный, т.е. наименования товаров (для примера), то макрос не нужен - "Данные/Проверка данных", и там уже указываете диапазон с которого этот список будет браться. Если данные обновляются динамически и нет постоянной длины списка, то берите с запасом.
В общий модуль с удалением дубликата из модуля листа:
Код
Public Меня_уже_Запускали
Sub НеВыпускают()
Dim a(), b1, i
a = Sheets("Калькуляция").[I75:I84].Value
Меня_уже_Запускали = Меня_уже_Запускали Xor 1
If Меня_уже_Запускали Xor 1 Then Exit Sub
b1 = "не бывает"
'Application.EnableEvents = False
For i = 1 To UBound(a)
If InStr(1, a(i, 1), b1, 1) Then
MsgBox "Столешницы в выбранном сочетании не выпускают", vbExclamation, "Категория": Exit For
End If
Next
'Application.EnableEvents = True
End Sub
П.С.: Задачу вы не сформулировали. Видимо чтобы два раза процедура не запускалась нужно вводить доп.глобальную переменную и ее менять и опрашивать при вызове этой процедуры.
- создаем пользовательскую форму с листбоксом (т.к. ввод посимвольно, а на один символ может быть множество значений) - находим в гугле/яндексе сортировщик по одномерному массиву и бинарный поисковик - создаем обработчик событий листа на изменение ячеек в первом столбце - обход всех листов в цикле - загоняем в словарь содержимое первых столбцов каждого листа - выгружаем словарь в массив и с ним уже работаем по сортировке/поиску/выборке - результат выборки по набранным буквам выгружаем в листбокс формы
Дмитрий(The_Prist) Щербаков, Jack Famous, БМВ, Так я о том, что разница по сути только в терминах (макрос/не макрос). Отличие VB от VBA (хотя кому я это рассказываю ) только в готовой (VBA) платформе. Если есть желание подчеркнуть свой труд в написании/отладке кода, то конечно можно назвать хоть скриптом, хоть программой или даже супер программой .
В MS Office VBA макросы, в VB - программы. Мне как-то начальник похвастался, что макрос написал - макрорекордером воспроизвел все свои ежедневные деяния в Excel. Собственно отсюда и хотелки с постами мол решите одну ерундовую задачку с описанием этой задачки на два экрана. Это же так легко...
Все это новшества ума и прочих полезных свойств с качествами не прибавят. Очередной костыль-посредник между гуманоидами и реальным миром. Но одновременно естественное развитие инструментария человечества.
Индия - одна из древнейших культур из ныне известных. Первые письменные источники и все такое. Сейчас обгоняют Китай по численности населения. 2к на кв.км.. Гадят практически под себя, но развивают промышленность, науку и технологии. Т.е. тенденция к возвращению к былому величию присутствует.
Человечество развивается только в индустриально-технологическом ключе. Все остальное на уровне допотопных времен.
Информации по VBA в сети вагон и маленькая тележка. Разбить на этапы и изучать сразу воплощая изучаемое иначе выветрится через пару месяцев. Есть макрорекордер, можно сначала оптимизировать те портянки кода, которые он родит используя циклы, массивы и конструкции With...End With