Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 След.
Создание словаря из таблицы-матрицы
 
testuser,  Большое спасибо! то что нужно.
Создание словаря из таблицы-матрицы
 
testuser,
Спасибо за быстрый ответ! В принципе я могу уже использовать ваш код, но желательно в словарь добавлять ключи с непустыми элементами, то есть если в таблице в перекрестье ячейка пустая, ключ в словарь не добавляется.
Создание словаря из таблицы-матрицы
 
Добрый день, уважаемые форумчане!

Просьба подсказать решение по заполнению словаря данными (ключ-элемент) не из линейной таблицы, как  у меня сейчас реализовано, а из таблицы-матрицы (она исходная).
Данные для ключа - это данные из первого столбца, сцепленные (например через пробел) с данными из первой строки таблицы.
Данные для элемента - значение ячейки (если она не пустая), находящееся в перекрестье относительно  ячеек (из которых собран ключ) для соответствующего ключа.

Сейчас код реализован так:
Скрытый текст
Изменено: CRAFT - 10.12.2023 13:04:43
Поиск текста в ячейке и выделение его цветом
 
Цитата
написал:
у меня возникли подозрения, что именно так все и будет))
Но всё же справился!
Код
Sub FormatA()
  Dim r&, re, ms, m, Iend As Integer
  Iend = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row 'последняя строка
' Сброс форматирования цвета текста
 Sheets("Таблица").Range("B2:B" & Iend).Font.ColorIndex = 1
'-------------------------
  Set re = CreateObject("VBScript.RegExp")
        re.Pattern = "(^| {1})[^- ]{2,}"    'шаблон поиска (начало строки или пробел, не содержит "-", кол-во символов от 2 и более)
        re.Global = True                 
  For r = 3 To Iend
    If re.Test(Cells(r, 2).Value) And Cells(r, 2) Like "*-*" Then
      Set ms = re.Execute(Cells(r, 2).Value)
      For Each m In ms
        Cells(r, 2).Characters(m.firstindex + 1, m.Length).Font.Color = RGB(64, 128, 128)   'задание цвета текста
      Next
    End If
  Next
  
End Sub

Ігор Гончаренко,  Ещё раз спасибо за рабочее решение и интересный способ решения!

Поиск текста в ячейке и выделение его цветом
 
Ігор Гончаренко,  Спасибо! С квадратиком не так легко для меня оказалось.

а цвет я задал так:
Код
Cells(r, 2).Characters(m.firstindex + 1, m.Length).Font.Color = RGB(12, 93, 118) 'задание цвета текста
Поиск текста в ячейке и выделение его цветом
 
 Ігор Гончаренко,, Огромное спасибо! Получилось лаконично. Я представлял себе  некую "простыню" кода.

Квадратик сделать обратно черным и цвет текста чтобы задавался напрямую, а не через ячейку  я думаю сам смогу поправить.
Изменено: CRAFT - 12.10.2023 13:30:32
Поиск текста в ячейке и выделение его цветом
 
Jack Famous, решение понимаю такое: для каждой ячейки диапазона определить участки текста  для выделения и выполнить форматирование?
Поиск текста в ячейке и выделение его цветом
 
Евгений Смирнов,  это нужно для удобства "чтения" этой таблицы. Вопрос немного некорректный, понимаю что скорее всего возможно,
но  намного сложней и неудобней реализация решения  через макрос в Excel по сравнению с решением через обработку в Word ?
Поиск текста в ячейке и выделение его цветом
 
Здравствуйте, уважаемые форумчане!
подскажите, есть ли решение задачи с помощью vba Excel?

Задача следующая: найти в каждой ячейке определенный текст (несколько результатов в ячейке) и выделить только его другим цветом.

Варианты исходных данных

Вариант 1 (предпочтительней)
искомая часть текста: с начала строки до символа "-"     [2901XT1-2]
и начиная с пробела до символа "-"_                                [_2901XT1-2]

либо

Вариант 2
искомая часть текста для выделения будет приведена в массиве(ячейках).

Пока решение данной задачи вижу следующее: копирование данных в Word, поиск искомых частей текста и их выделение, копирование в Excel.
Поиск ячейки с текстом и объединение смещенных от неё ячеек
 
Бахтиёр,  это конечно сильно упрощённый пример, поэтому выглядит нелогично. Как данность  в первом столбце будут уникальные названия, но у некоторых названий  кол-во объединенных ячеек вниз разное (2 или 3). В любом случае в массиве будут названия с одинаковым количеством объединенных ячеек и противоречий при объединений столбцов не возникнет. Для объединения ячеек на разное количество строк я создам разные массивы с разными условиями объединения.
Поиск ячейки с текстом и объединение смещенных от неё ячеек
 
Здравствуйте!
Помогите пожалуйста написать макрос!
Упрощенный пример требуемой задачи ниже и в приложении.

Требуется:
1. найти каждую ячейку с текстом (искомый текст указывается массивом)
2. справа от нее и вниз объединить ячейки 3 ячейки (например искомый текст нашелся в "A2", тогда объединить ячейки "B2" "B3" и "B4" в одну, а ячейки "C2" "C3" и "C4" в другую.
3. Аналогично по другим ключевым словам.

Заранее спасибо!
Сортировка столбцов циклом в каждой строке
 
New, Теперь заработало!
Спасибо!  
Сортировка столбцов циклом в каждой строке
 
New, а так не работает!
Сортировка столбцов циклом в каждой строке
 
New, Большое спасибо!
Сортировка столбцов циклом в каждой строке
 

Цитата
написал:
Не понял сам - где косяк?
Попробуйте как макрорекордер прописал  
Код
    [URL=#]?[/URL]       1  2  3  4  5  6  7  8  9  10  11  12  13  14  15      Sub   Макрос1()    Dim   R   As   Range    For   Each   R   In   Range(Cells(2, 2), Cells(2, 2).SpecialCells(xlLastCell)).Rows        With   ActiveSheet.Sort          .SortFields.Clear          .SortFields.Add R, xlSortOnValues, xlDescending, , xlSortNormal          .SetRange R          .Header = xlNo          .MatchCase =   False          .Orientation = xlLeftToRight          .SortMethod = xlPinYin          .Apply        End   With    Next   R    End   Sub   
 
Заметил, что макрос в качестве последней ячейки в моей книге принимает значение за 4000 строк, в реальности же таблица не более 500 строк.
Из-за этого макрос выполняется слишком уже медленно (минуты!)
видимо из-за этого

Код
.SpecialCells(xlLastCell)).Rows


нашёл такое решение

Код
'переопределяем рабочий диапазон листа
    With ActiveSheet.UsedRange: End With

Можно ли
Код
SpecialCells(xlLastCell)).Rows
заменить на другую запись типа?
Код
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Транспонирование данных, диапазоны ограничены разделителями
 
Спасибо всем, кто откликнулся!
Транспонирование данных, диапазоны ограничены разделителями
 
Александр П.,  Благодарю!

Тимофеев, Спасибо! Обязательно вариант с формулой тоже попробую (но в другой версии EXCEL, на этой такой функции нет...)
Транспонирование данных, диапазоны ограничены разделителями
 
Александр П.,  Огромное спасибо!
а если немного изменить условие (на листе оставить только транспонированные данные а исходные удалить) так проще будет макрос?
если нет, то  столбец А я сам удалю макросом после цикла.
Транспонирование данных, диапазоны ограничены разделителями
 
jakim, Спасибо за ответ!
Но интересует решение без Power Query.
К тому же предложенное вами решение конкретно под данную задачу (я понимаю что каков вопрос, таков и ответ). Под словами "Название" и "адреса" по факту может быть любой текст с любым набором цифр и символов, но общее у них, что после "("  на следующей строчке идет всегда "название"  на других строчках разное количество "адресов" и заканчивается ")". И так в каждой группе.
Транспонирование данных, диапазоны ограничены разделителями
 
Здравствуйте уважаемые форумчане!

Подскажите макрос для транспонирования данных находящихся в столбце А. Каждый диапазон из этого столбца, который нужно транспонировать строку, разделён. В моём случае это:
"(" - начало диапазона
")" - конец диапазона

Данным кодом я нахожу первый диапазон, дальше мне видется вырезать и транспонировать в столбец В и циклом перейти к следующему.
Код
Dim iA As Long, iB As Long
    iA = Columns("A").Find("(", [A1], LookIn:=xlValues, SearchDirection:=xlNext).Row
    iB = Columns("A").Find(")", [A1], LookIn:=xlValues, SearchDirection:=xlNext).Row
Range(Cells(iA, 1), Cells(iB, 1)).Select
Но конечно есть и более удачное и элегантное решение!

Заранее спасибо!
Сортировка столбцов циклом в каждой строке
 
Апострофф, огромное спасибо!
всё работает как надо!
Сортировка столбцов циклом в каждой строке
 
Высылаю тот же самый файл. Сделал дубликат листа "Исходник"
На "исходник" макрос работает
на "исходник (2)" не работает.
от чего это зависит, пока не разобрался.
Сортировка столбцов циклом в каждой строке
 
Апострофф, Почему то работает только на листе примера, при дублировании этого листа с данными, на новом уже не работает. Вроде нет привязки к конкретному листу в макросе....
Сортировка столбцов циклом в каждой строке
 
Апострофф, спасибо за ответ! но у меня работает только в файле примера. Буду смотреть различия между файлом примера и других проектов.
Код лаконичный, но пока не могу адаптировать для себя!
Изменено: CRAFT - 05.02.2023 13:03:56
Сортировка столбцов циклом в каждой строке
 
Здравствуйте, уважаемые форумчане!
Задача отсортировать ячейки по убыванию отдельно в каждой строке (исключая первую строку заголовков и первый столбец названий)
начиная с ячейки B2
количество используемых ячеек в каждой строке разное
количество строк тоже разное (в разных проектах).

Авторекодером записал сортировку для одной строки.
Код
Option Explicit
Public endRow As Integer

Sub Сортировка_строки()

endRow = Sheets("исходник").Cells(Rows.Count, 1).End(xlUp).Row

' cортировка одной строки
    ActiveWorkbook.Worksheets("исходник").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("исходник").Sort.SortFields.Add2 Key:=Range("B2:R2" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("исходник").Sort
        .SetRange Range("B2:R2")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Для сортировки остальных строк я думаю использовать цикл с перебором каждой строки до конечной (EndRow),
но с синтаксисом цикла я пока не дружен.
Подскажите пожалуйста структуру цикла для данной задачи!

Заранее спасибо!
Ошибка 1004 при попытке выполнить ActiveWorkbook.SaveAs, если используется переменная папки.
 
Макрос 1 тоже заработал. Причиной явилась ошибка в макросе, при которой новая папка создавалась из конкатенации двух ячеек (имя и город).
Если ячейка город была пуста, то папка создавалась из значения ячейки b3 и ПРОБЕЛА, но файл в нее почему-то не записывался. Плохо протестировал код, и в примере привел не полностью. отсюда и ошибки.
Код
zName = Replace_symbols(ActiveWorkbook.Sheets("dannye").Range("b3").Value & " " & ActiveWorkbook.Sheets("dannye").Range("e3").Value)  'имя папки и город

Прошу прощения за потерю времени, за нахождении несуществующей ошибки и благодарю всех откликнувшихся.

Изменено: CRAFT - 17.07.2019 22:39:10
Ошибка 1004 при попытке выполнить ActiveWorkbook.SaveAs, если используется переменная папки.
 
После танцев с бубном, а также, отключением всех программ в трее, приостановлении работы антивируса и т.д., Макрос 2 после двухмесячного отпуска заработал! после перезагрузки системы работоспособность макроса сохранилась.

Макрос 1 работать не хочет (из этого делаю вывод что причины наверно разные).
Ошибка 1004 при попытке выполнить ActiveWorkbook.SaveAs, если используется переменная папки.
 
RAN, Punto Switcher отключил! Не помогло
Ошибка 1004 при попытке выполнить ActiveWorkbook.SaveAs, если используется переменная папки.
 
sokol92,  в буфер обмена Office попал,  при вставке в ячейку копируются 2 квадрата, если вставлять из буфера обмена  (нажатием) то вставляется норм.
Скрытый текст
Изменено: CRAFT - 17.07.2019 21:41:14
Ошибка 1004 при попытке выполнить ActiveWorkbook.SaveAs, если используется переменная папки.
 
sokol92, в блокнот ничего не вставляется
в код VBA если произвести вставку, то ??
Страницы: 1 2 3 След.
Наверх