Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Изменение элемента массива, являющегося элементом словаря
 
По мотивам ЭТОЙ темы.
Здравствуйте Уважаемые!
Давно хотел уточнить у Вас, дорогие друзья, такой вопрос.
Есть Словарь элементами которого являются Массивы
Как (и можно ли в принципе), напрямую, без передачи Массива в переменную, изменить какое нибудь его значение?
Прочитать единичное значение напрямую получается, а вот изменить никак.
Макрос складывает отдельные значения по ключу.
Может где-то в синтаксисе туплю...
Код
Private Sub CommandButton1_Click()
Dim x(), iArr(), newArr(), I&, J&
x = Range("A1:F4").Value
On Error Resume Next
With CreateObject("Scripting.Dictionary")
    For I = 1 To UBound(x)
        .Add x(I, 1), Application.Index(x, I, 0)
        If Err <> 0 Then
            'так работает
            iArr = .Item(x(I, 1))
            For J = 2 To UBound(iArr)
                iArr(J) = iArr(J) + x(I, J)
            Next
            .Item(x(I, 1)) = iArr
'            'необходимо увеличить каждый элемент массива на определенное значение
'            'прямое изменение элемента массива не работает
'            For J = 2 To UBound(.Item(x(I, 1)))
'                .Item(x(I, 1))(J) = .Item(x(I, 1))(J) + x(I, J)
'            Next
            Err.Clear
        End If
    Next
    ReDim newArr(1 To .Count, 0 To UBound(x, 2)): I = Empty
    For Each iKey In .Keys
        I = I + 1: newArr(I, 0) = I
        'простое обращение к элементу массива работает
        For J = 1 To UBound(.Item(iKey))
            newArr(I, J) = .Item(iKey)(J)
        Next
    Next
End With
Range("A16").Resize(UBound(newArr), UBound(newArr, 2) + 1) = newArr
End Sub
Согласие есть продукт при полном непротивлении сторон.
Изменение названий тем в Избранном
 
Доброго времени суток, коллеги.
Существует ли возможность изменения названия Темы (или, хот-бы, добавление примечания/тэга) в Избранном? Не всегда название Темы, данное ей ТС при создании, отражает то решение, которое мне показалось интересным.
Спасибо  
Согласие есть продукт при полном непротивлении сторон.
Copy/Past кирилицы из VBE в сообщение на форуме в браузере MS Edge, Смена раскладки клавиатуры РУС/ENG не помогает
 
Доброго всем утра!
Решил более плотно попользовать MS Edge и столкнулся с проблемой указанной в описании темы. Не зависимо от раскладки клавиатуры (РУС/ЛАТ) кирилица не хочет копироваться в тело сообщения на форуме. Причем совсем не так, как например в Chrom'е. Это сообщение набираю в Chrom'е
Примеры
Браузер Chrome Версия 67.0.3396.87 (Официальная сборка), (64 бит)
Раскладка РУС
Код
Sub Test()
    'Русский язык, кирилица
    'браузер Chrome Версия 67.0.3396.87 (Официальная сборка), (64 бит)
End Sub
Раскладка ENG
Код
Sub Test()
    'Ðóññêèé ÿçûê, êèðèëèöà
    'áðàóçåð Chrome Âåðñèÿ 67.0.3396.87 (Îôèöèàëüíàÿ ñáîðêà), (64 áèò)
End Sub
Браузер Microsoft Edge 42.17134.1.0
Раскладка РУС
Код
Sub Test()
    '??????? ????, ????????
    '??????? Chrome ?????? 67.0.3396.87 (??????????? ??????), (64 ???)
End Sub
Раскладка ENG
Код
Sub Test()
    '??????? ????, ????????
    '??????? Chrome ?????? 67.0.3396.87 (??????????? ??????), (64 ???)
End Sub
Обратите внимание, что в Chrom, при раскладке ENG, вместо кирилицы копируются какие-то 'иероглифы', а в Edge вопросительные знаки. Причем не зависимо от раскладки.
В чем причина? Как победить?
P.S. Могу ошибаться, но где то мелькало, что Михаил (БМВ) использует MS Edge
Согласие есть продукт при полном непротивлении сторон.
VBA. Номер области в коллекции Areas, Определить номер области в коллекции Areas диапазона для ячейки
 
Здравствуйте коллеги!
В приложенном файле, в диапазоне 'DAYS', 12 несмежных областей.
Как определить номер области, в которую попадает, допустим, активная ячейка, без перебора областей, коллекции Areas, этого диапазона?
Код с определением номера в цикле
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("DAYS")) Is Nothing And Target.Count = 1 Then
    On Error Resume Next
    For I = 1 To Range("DAYS").Areas.Count
        If Not Intersect(Target, Range("DAYS").Areas(I)) Is Nothing Then
            iMonth = I
            Select Case I
                Case 1, 3, 5, 7, 8, 10, 12
                    eDay = 31
                Case 4, 6, 9, 11
                    eDay = 30
                Case 2
                    eDay = 28   'для високосного года исправить на 29
            End Select
            Exit For
        End If
    Next
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target >= 1 And Target <= eDay Then
        Target = DateSerial(2018, iMonth, Target)
        Target.NumberFormat = "dd; @"
    Else
        MsgBox "Неверная дата!", vbCritical + vbOKOnly, "Ошибка"
        Target = Empty
        GoTo ExitSub
    End If
End If
ExitSub:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Файл слямзил в ЭТОЙ теме, да простит меня TiduSan  :)  
Изменено: Sanja - 19 Янв 2018 20:53:56
Согласие есть продукт при полном непротивлении сторон.
Вопрос не по форуму, но по сайту, Код в некоторых статьях Приёмов расположен в одну строку
 
Доброго времени суток, Уважаемые!
Заметил, что в некоторых статьях раздела Приёмы (например), код расположен в одну строку, и, соответственно, при его копировании с сайта он так же вставляется в модуль одной строкой. Приходится его вручную разносить по строкам
Это только у меня так?
Можно ли это поправить?
Спасибо
Изменено: Sanja - 11 Авг 2017 19:43:10
Согласие есть продукт при полном непротивлении сторон.
VBA. Заполнение ListBox с несколькими столбцами, на форме, массивом данных, Не разносятся по столбцам данные, если в массиве одна строка
 
Доброго всем времени суток!
Вчера столкнулся с таким феноменом.
При заполнении ListBox'а на форме массивом данных, при наличии в массиве только ОДНОЙ строки, данные по столбцам не раскидываются, а собираются в один столбец.
Из положения вышел при помощи 'костыля' с проверкой на количество строк и добавлением еще одной строки с пустыми значениями.
Проверить можно вкл/откл 'костыль' и выбрав Исполнитель: Шкурина, Квартал: IV
В чем причина? Где я туплю?
Скрытый текст
Согласие есть продукт при полном непротивлении сторон.
Не работает прокрутка страниц сайта колесиком мыши
 
Второй раз сутки вдруг перестают прокручиваться страницы сайта колесиком мыши. С остальными сайтами и локальными страницами проблем нет. Закономерность пока не заметил, после чего отваливается колесико, не понятно. Обновление страниц не помогает, только перезапуск всего браузера (Chrome  57.0.2987.98 (64-bit))

Поймал. Если в момент обновления любой страницы сайта крутануть колесико, то по окончании обновления колесико не работает
Изменено: Sanja - 6 Апр 2017 13:21:24
Согласие есть продукт при полном непротивлении сторон.
8 Марта !!!
 
Милые наши девушки! От души поздравляю Вас всех с прекрасным весенним Праздником!
Согласие есть продукт при полном непротивлении сторон.
Изменение шрифта части текста в колонтитуле, Изменение шрифта части текста в колонтитуле
 
Доброго времени суток, ДрУги во программировании на VBA!
Второй день бьюсь с проблемой программного изменения шрифта (название, полужирность и проч.) в ЧАСТИ текста колонтитула
Наш друг пишичитай макрорекордер, кроме всего прочего, дает такой код
Код
Sub Макрос3() 'записано макрорекордером
    With ActiveSheet.PageSetup
        .LeftHeader = "&""Arial,полужирный""СТР:&""-,обычный"" &D &T"
        .CenterHeader = "&""Arial,полужирный""СТРАНА:&""-,обычный"" Россия &""Arial,полужирный""РЕГИОН: &""-,обычный""Москва"
        .RightHeader = "&""Arial,полужирный""САЙТ:&""-,обычный"" WWW.MOS.GOV"
    End With
End Sub
так вот в этой заготовке никак не могу заменить некоторые слова на переменные
Код
Sub PreKolon2()
Country$ = "Россия"
City$ = "Москва"
Site$ = "WWW.MOS.GOV"
    With ActiveSheet.PageSetup
        .LeftHeader = "&""Arial,полужирный""СТР:&""-,обычный"" &D &T"   'Дата и Время
        
        'слова Россия, Москва заменить переменными Country, Сity
        .CenterHeader = "&""Arial,полужирный""СТРАНА:&""-,обычный"" Россия &""Arial,полужирный""РЕГИОН: &""-,обычный""Москва"
        
        'WWW.MOS.GOV заменить на Site
        .RightHeader = "&""Arial,полужирный""САЙТ:&""-,обычный"" WWW.MOS.GOV"
    End With
    ActiveSheet.PrintPreview
End Sub
Т.к. апмперсанд (&), кроме того, что он оператор объединения строк, в колонтитулах он еще и управляющий символ (см. строку с Датой и Временем)
Никак не могу правильно расставить эти амперсанды с кавычками.
В файле два листа. Первый - колонтитулы выставлены и оформлены вручную, второй - нужно так-же сделать программно, через переменные
Спасибо.
Согласие есть продукт при полном непротивлении сторон.
Подавление ошибки в массивной UDF
 
Добрый всем вечер.
В этой теме соорудил UDF, которую нужно вводить как формулу массива. Соответственно размер диапазона, куда она вводится, заранее не известен и, при включении в него "лишних" ячеек в них появляется #Н/Д. Как с этим бороться? Штатные ЕСЛИОШИБКА(), связка ЕСЛИ() и всяких ЕНД() не работают. Условное форматирование НЕ предлагать.
Спасибо
Код
Function UNIQUE(rng As Range) As Variant
Dim tmpArray()
Dim tmpCol As New Collection
On Error Resume Next
tmpArray = rng.Value
For I = LBound(tmpArray, 1) To UBound(tmpArray, 1)
    For J = 1 To rng.Columns.Count
        tmpCol.Add tmpArray(I, J), CStr(tmpArray(I, J))
    Next
Next
ReDim tmpArray(tmpCol.Count - 1, 1)
For I = 0 To tmpCol.Count - 1
    tmpArray(I, 0) = tmpCol(I + 1)
Next
UNIQUE = tmpArray
End Function
Согласие есть продукт при полном непротивлении сторон.
Замена оператора сравнения (=;<>; и т.п.) на переменную.VBA
 
Добрый день, коллеги.
Давно мучает вопрос упрощения использования операторов сравнения в UDF (и не только)
Например, когда нужно использовать оператор в критерии отбора.
Видел как Дмитрий (The_Prist) вышел из подобной ситуации
Смотрю в сторону Application.Evaluate, но...то ли лыжи не едут
При пошаговом проходе по второй функции, отслеживая Application.Evaluate("If(" & rng2.Parent.Cells(cl.Row, rng2.Column) & kr & ")"), в Watches, вообще непоняные мне значения (числовое значение критерия умноженное на 100, иногда True).
Надеялся, что будут True/False
Ниже код UDF с жестко прописанным оператором и попытка ее унифицировать. И файл-пример их использования
Натокните на мысли. Или развейте надежды
Спасибо
Скрытый текст
Согласие есть продукт при полном непротивлении сторон.
Приношу извинения, Утро вечера мудренее...
 
Вчера в ЭТОЙ теме психанул и позволил себе ответить ТС ссылкой на один, узкоспециализированный ресурс.
Оправданий себе не ищу
1. Приношу извинения пользователю Forcer
2. Приношу извинения всему Уважаемому сообществу
3. Т.к. тема закрыта, прошу модераторов удалить злополучную ссылку
4. Готов понести справедливое наказание

З.Ы. Forcer, я не сомневаюсь что Вы опытный участник различных форумов, создайте тему, соответствующую Правилам ЭТОГО форума, и помощь не заставит себя ждать.
Еще раз извините.  
Согласие есть продукт при полном непротивлении сторон.
Присваивание значений необязательным аргументам пользовательской функции (UDF) в коде самой функции, как массово присвоить значение необязательным аргументам
 
Добрый вечер, коллеги!
При решении вопроса в ЭТОЙ теме написал UDF, которая подсчитывает количество уникальных значений по двум условиям.
У Автора той темы возник вопрос об увеличении количества условий поиска уникальных.
В процессе доработки возник вопрос : Как присвоить необязательным аргумента значения по умолчанию, НО не константы?

Объявление функции таким способом
Function СЧЁТУНИКЕСЛИМН(rngU As Range, _     rng1 As Range, kr1 As Variant, Optional rng2 As Range = rng1, Optional kr2 As Variant = kr1, .........)
конечно же привел к ошибке.

Доработал функцию таким методом, но, мне кажется, есть какой-то другой способ. Или мне действительно кажется?
Как быть при действительно большом количестве однотипных необязательных аргументов?
Спасибо
Скрытый текст
Изменено: Sanja - 27 Мар 2016 11:09:00
Согласие есть продукт при полном непротивлении сторон.
Чем заменить фигурные скобки в MATCH (ПОИСКПОЗ) в VBA, ругается на них
 
Собственно вопрос в теме
строка кода примерно такая.
Код
mDate = WorksheetFunction.Match("мар", {"янв","фев","мар","апр","мая","июн","июл","авг","сен","окт","ноя","дек"})
Пишет какой-то Invalid...  :) и указывает на первую фигурную скобку
хотя в справке черным по английскому
  • Цитата
    MATCH returns the position of the matched value within lookup_array, not the value itself. For example, MATCH("b",{"a","b","c"},0) returns 2, the relative position of "b" within the array {"a","b","c"}.

в чем подвох? и как поправить?
Спасибо
Изменено: Sanja - 28 Фев 2016 23:03:13
Согласие есть продукт при полном непротивлении сторон.
Формат ячейки ДДД не соответствует номеру дня недели, отображение дня недели (Пн, Вт и т.д.) после применения формата "ДДД" не соответствует его номеру (1,2 и т.д.)
 
Собственно сабж в описании темы.
Может кто проверит в аглицкой версии?
Изменено: Sanja - 21 Ноя 2014 15:49:46
Согласие есть продукт при полном непротивлении сторон.
Хромает "цитирование"
 
Не при цитировании с выделенным текстом, не при цитировании просто имени, само ИМЯ не вставляется в сообщение. Проверено в FF и GCh (Google Chrome)
Изменено: Sanja - 12 Мар 2014 18:03:10
Согласие есть продукт при полном непротивлении сторон.
Динамическая "таблица" для ВПР, Связка ВПР+ИНДЕКС+ПОИСКПОЗ
 
Добрый вечер!
В этой теме многоуважаемый Михаил С. предложил, на мой взгляд, очень элегантное решение:
Код
=ВПР(B3;ИНДЕКС(G3:G17;ПОИСКПОЗ(B2;F3:F17;0)):ИНДЕКС(H3:H17;ПОИСКПОЗ(B2;F3:F17));2;0)
формула, в которой каждый из двух блоков ИНДЕКС(..ПОИСКПОЗ...) возвращает значение соответствующей ячейки, НО их связка (через двоеточие) для ВПР является аргументом "таблица", в которой ВПР и ищет значение. Объясните неразумному логику формулы? Как такое может быть? Роль двоеточия?
Мануалов, справок и поисков "скурил" достаточно. Сразу прошу меня простить ("прощенное воскресенье" все-таки  :) )
Файл из вышеуказанной темы прилагаю
Спасибо
Согласие есть продукт при полном непротивлении сторон.
Удаление УФ макросом, макрос удаляет только половину правил УФ и вылетает с ошибкой
 
Для помощи в этой теме написал такой макрос:
Код
Sub fmtCDDEL()
Dim fmtCD As FormatCondition
On Error GoTo Err
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With
With Cells.FormatConditions
Ans = MsgBox("В Вашем файле " & .Count & " правил условного форматирования!" & Chr(13) & "Удалить их?", vbInformation + vbYesNo)
If Ans = vbNo Then Exit Sub
I = 1
Do While .Count <> 0
    Cells.FormatConditions(I).Delete
    Application.StatusBar = "Удаляется " & I & " правило. Пожалуйста подождите...."
    DoEvents
    I = I + 1
Loop
End With
Err:
With Application
If Cells.FormatConditions.Count <> 0 Then
        .StatusBar = "Не удалено " & Cells.FormatConditions.Count & ", запустите макрос еще раз..."
    Else
        .StatusBar = False
    End If
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With
End Sub
но без обработчика ошибок он удаляет РОВНО половину правил УФ и вылетает с ошибкой Subscript out of range. Приходится повторно его запускать, НО опять до удаления половины оставшихся правил УФ. И так пока все не удаляться. В чем причина? Файл не прикладываю - больно тяжел. Можно взять по ссылке в первом посте
Согласие есть продукт при полном непротивлении сторон.
Конструкция If...Or...Then... выдает ошибку, а условия, разнесенные на два If...Then работают, в названии
 
Вчера, при разборе этой темы, столкнулся со следующим:
вот этот код
Код
Sub SaveText_2()
Dim SH As Object
I = 1
For Each SH In ActiveSheet.Shapes
    With SH.OLEFormat.Object
        If SH.Type <> msoTextBox Or .Text Like "*Внимание*" Then GoTo 10
            Worksheets(2).Range("A" & I).Value = .Text
    End With
I = I + 1
10 Next
End Sub
вылетает с ошибкой на строке If SH.Type<>....Or... Then...Код ошибки: Run-time error 438: Object doesn't support this property or method
Если желаемое записать вот так:
Код
Sub SaveText_3()
Dim SH As Object
I = 1
For Each SH In ActiveSheet.Shapes
    With SH.OLEFormat.Object
        If SH.Type <> msoTextBox Then GoTo 10
        If .Text Like "*Внимание*" Then GoTo 10
            Worksheets(2).Range("A" & I).Value = .Text
    End With
I = I + 1
10 Next
End Sub
все работает.
В чем ошибка? Прилагаю файл с которым вчера "боролись"
Согласие есть продукт при полном непротивлении сторон.
свойство Range, возвращающее букву столбца, Как в VBA получить "букву" столбца ?
 
Всем доброго времени суток!
Как в VBA получить "букву" столбца? В стандартных свойствах Range не нашел  :(
Согласие есть продукт при полном непротивлении сторон.
СЧЕТЕСЛИ если есть хотя-бы одно значение в нескольких столбцах
 
Помогите, чё-т туплю...(может уже в отпуск пора  :)  )
Нужно формулой посчитать количество сотрудников, у которых в квартале (полугодии) есть хотя-бы одна галка
Спасибо
Согласие есть продукт при полном непротивлении сторон.
Убрать с UserForm кнопку "Во весь экран"
 
Добрый вечер!
Помогите разобраться в API (сам не силен, к сожалению).
Вот это код:
Код
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Const GWL_STYLE As Long = (-16)
Private Const WS_SYSMENU As Long = &H80000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000

Private Sub UserForm_Initialize()
Dim lngFrmHndl As Long, lngStyle As Long
    
    lngFrmHndl = FindWindow(vbNullString, Me.Caption)
    lngStyle = GetWindowLong(lngFrmHndl, GWL_STYLE)
    lngStyle = lngStyle Or WS_SYSMENU
    lngStyle = lngStyle Or WS_MINIMIZEBOX
    lngStyle = lngStyle Or WS_MAXIMIZEBOX
    SetWindowLong lngFrmHndl, GWL_STYLE, (lngStyle)
    DrawMenuBar lngFrmHndl
End Sub

добавляет на UserForm кнопки "Свернуть/Развернуть" и "Во весь экран". Что в нем нужно убрать (добавить?) что-бы осталась только "Свернуть/Развернуть"
Спасибо!
Согласие есть продукт при полном непротивлении сторон.
Application.EnableEvents для событий UserForm
 
С вербным воскресеньицем всех!
Помогите пожалуйста!
Как отключить обработчик события контрола UserForm инициируемый из обработчика события другого контрола на этой-же форме?
Что-то на подобии Application.EnableEvents для событий листа.
Подскажите кто как выходит из положения?

З.Ы. Про применение глобальных переменных-флагов читал, но что-то не срабатывает
Согласие есть продукт при полном непротивлении сторон.
Преобразовать таблицу в диапазон (VBA)
 
Доброго времени суток!
Есть строка кода:
Код
    .ListObjects.Add(xlSrcRange, .Range("A1:B" & LastCol - 1), , xlYes).TableStyle = "TableStyleLight19"

которая из диапазона .Range("A1:B" & LastCol - 1) делает таблицу и применяет к ней стиль.
Как программно преобразовать данный диапазон обратно в "диапазон" с сохранением стиля. Вручную получается, но макрорекордер ничего не записывает.
Спасибо!
Согласие есть продукт при полном непротивлении сторон.
Два "приема" в один
 
На досуге соединил два "приема" из копилки Н. Павлова в один (отметка строк таблицы "галочкой" и заполнение бланков). Вот что получилось. Вроде ничего  ;)
Согласие есть продукт при полном непротивлении сторон.
Страницы: 1
Наверх