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

Страницы: 1 2 След.
Вычисление результата в зависимости от того, является аргумент текстом или числом
 
 А зачем вы слова умножаете на цифры? Например, слово "Анулируем умножаете на 1,316"
Изменено: Михаил О. - 21.08.2020 23:32:47
Я не Михаил...
Как облегчить редактирование большого текста в ячейке?, .
 
Евгений, нужно в Настеном файле в модуле формы (UserForm1) найти фразы ActiveCell.Formula и заменить их на ActiveCell.FormulaLocal
В приложенном файле от Насти я уже это заменил, можете взять этот файл
Изменено: Михаил О. - 21.08.2020 22:41:32
Я не Михаил...
VBA Присваивание значения переменной Range. Ссылка фактически идет не на ту книгу
 
Равик, у Range и Cells обязательно нужно указывать родителя (лист), кроме случаев когда вы работаете с Активным листом (тогда ничего не надо указывать).
В вашей строке код у Cells не указан родитель, поэтому Cells обращается к активному листу

Вот 2 варианта правильного указания родителя у Range и Cells (напомню, это очень важно, если вы работаете НЕ с активным листом)
1-й вариант более длинный, второй более короткий, но обязательно нужно ставить точки перед Range и Cells

Код
Sub test()
    
    'ВАРИАНТ 1
    Set OOOstatkiCopy = Workbooks("Общие остатки.xlsx").Worksheets("Stock") _
         .Range(Workbooks("Общие остатки.xlsx").Worksheets("Stock").Cells(UpperCellRow, 3), _
                Workbooks("Общие остатки.xlsx").Worksheets("Stock").Cells(OOlRow, 3))
    'ВАРИАНТ 2
    With Workbooks("Общие остатки.xlsx").Worksheets("Stock")
         Set OOOstatkiCopy = .Range(.Cells(UpperCellRow, 3), .Cells(OOlRow, 3))
    End With
                
End Sub
Изменено: Михаил О. - 21.08.2020 22:26:20
Я не Михаил...
Как облегчить редактирование большого текста в ячейке?, .
 
mymail, добавил такую функцию для формы - при нажатии клавиши Escape форма закрывается.

Это будет удобно, когда вам надо проверить ваш текст, но менять, например, ничего не стали, нажимаете Escape и форма закроется (просто чтобы мышкой не нажимать кнопку Отмена на форме)
Я не Михаил...
Как облегчить редактирование большого текста в ячейке?, .
 
В моем файле вам надо зайти в модуль Лист1 и скопировать тот код в модуль вашего листа в своем файле.
да-да, код может быть не только в Module1 и UserForm, код так же может быть в модуле каждого листа.
так же нажмите, как обычно, Alt+F11, и 2 раза щёлкните на модуле Лист1 и увидите код. Его и скопируйте в модуль листа с данными в вашей книге
Изменено: Михаил О. - 21.08.2020 20:45:25
Я не Михаил...
Как облегчить редактирование большого текста в ячейке?, .
 
Оба примера одинаковы, отличаются лишь способом вызова/отображения формы. Используйте тот, который вам больше подходит и удобнее для ваших задач.

БМВ, так! Тихо, спокойно! Давайте без массивных)))
Изменено: Михаил О. - 21.08.2020 20:37:34
Я не Михаил...
Как облегчить редактирование большого текста в ячейке?, .
 
Изменил для формулы
Я не Михаил...
Как облегчить редактирование большого текста в ячейке?, .
 
Вот ещё вариант  
Я не Михаил...
Подстановка значения из выпадающего списка в зависимости от значения соседней ячейки
 
заменять ничего в формуле не надо. Надо из 1-го столбца удалить Проверку данных, в ячейку А2 вставить эту формулу и протянуть вниз и по идее будет то, что вы хотели - вводите во 2-м столбце цвет и в 1-м столбце он отобразится или же будет пусто
Я не Михаил...
Подстановка значения из выпадающего списка в зависимости от значения соседней ячейки
 
Добработаю формулу от Сергей, чтобы было пусто, когда цвет не найден

Код
=ЕСЛИОШИБКА(ВПР(B2;name55;1;0);"")

P.S. Понимаете... я всю жизнь закупаю из Китая то канцелярию, то наушники, кабели, зарядки, чехлы, чайники, пылесосы, телефоны и т.д.... Мало интересный товар... а вот думал всегда - кто-то же закупает интересный "товар" ))
Изменено: Михаил О. - 21.08.2020 15:40:16
Я не Михаил...
Подстановка значения из выпадающего списка в зависимости от значения соседней ячейки
 
OFFTOPIC
Ураа, я наконец-то нашёл живого человека, кто занимается этим "товаром"))  А я всё думал - ну, кто-то же должен закупать, анализировать такой "товар" ))
P.S. Завидую )

По теме - а какой смысл вбивать цвет во втором столбце и чтоб он выбирался в первом столбце? Можно конечно макрос написать... он будет переносить введённый вами цвет из 2-го столбца в 1-й  
Изменено: Михаил О. - 21.08.2020 15:31:50
Я не Михаил...
Добавление в контекстное меню при включении надстройки
 
В структуре файла есть xml файл CustomUI.xml
там и прописано добавлять пункт в контекстное меню.
Чтобы посмотреть этот файл смените расширение xlam на zip. Откройте архив там будет папка CustomUI, а в ней этот файл xml
Так же ссылка на этот файл есть в файле из папки _rels
Изменено: Михаил О. - 21.08.2020 14:01:08
Я не Михаил...
Навести мышку на картинку в нужное место и считать RGB одного пикселя.
 
Давайте файл, будем смотреть
Я не Михаил...
Почему VBA функция IsNumeric не распознаёт числа
 
Ну, видите, общими усилиями справились
Я не Михаил...
Макрос по копированию и переносу выделенных ячеек на другой лист
 
Ну, Сергей... пришлось почти весь код переписывать)
См. файл.

P.S. А зачем вы 3-й лист с которого надо брать данные назвали вот так "04-15-01-М291-М-29" - тут нет сочетания М-291 (М291 не равно М-291)

Вот сам код

Код
Sub Перенести_материалы_на_Форму230()
    Dim Sht As Worksheet, Rng As Range, arrData, lastCol As Long, counter As Long, i As Long, lastRowBazaSht As Long
    Dim BasaSht As Worksheet, PererashodRow As Long, SheetsCount As Long
    
    If MsgBox("Собрать данные с листов в Форму-230?", vbQuestion + vbYesNo, "Вопрос") = vbNo Then Exit Sub
    
    Set BasaSht = Worksheets("ФОРМА-230") 'лист куда будем собирать все данные
    
    'цикл по всем листам в файле
    For Each Sht In ThisWorkbook.Worksheets
        'если название листа содержит М-291
        If Sht.Name Like ["*М-291*"] Then
            SheetsCount = SheetsCount + 1 'счётчик обработанных листов
            With Sht
                'номер строки с "Итого: расход по норме"
                Set Rng = .Cells.Find("Итого: расход по норме", , xlFormulas, xlWhole)
                If Rng Is Nothing Then
                    MsgBox "На листе " & Sht.Name & " не найдена ячейка 'Итого: расход по норме'!", vbExclamation, "Внимание"
                    Exit Sub
                End If
                PererashodRow = Rng.Row
            
                Set Rng = .Cells.Find("Наименование материалов", , xlFormulas, xlWhole)
                If Rng Is Nothing Then
                    MsgBox "На листе " & Sht.Name & " не найдена ячейка 'Наименование материалов'!", vbExclamation, "Внимание"
                    Exit Sub
                End If
                'номер столбца с последними данными (с последним материалом)
                lastCol = .Cells(Rng.Row + 1, .Columns.Count).End(xlToLeft).Column
                
                'определяем размер массива под заполнение данными
                ReDim arrData(1 To ((lastCol - Rng.Column) / 2) + 1, 1 To 4)
                counter = 0
                For i = Rng.Column To lastCol
                    If Not IsEmpty(.Cells(Rng.Row + 1, i)) Then
                        counter = counter + 1
                        arrData(counter, 1) = .Cells(Rng.Row + 1, i) 'название материала
                        arrData(counter, 4) = .Cells(PererashodRow, i + 1) 'расход по норме
                    End If
                Next i
            End With
            
            'выгрузка данных на лист ФОРМА-230
            With BasaSht
                Set Rng = .Cells.Find("Наименование материала", , xlFormulas, xlWhole)
                If Rng Is Nothing Then
                    MsgBox "На листе " & BasaSht.Name & " не найдена ячейка 'Наименование материала'!", vbExclamation, "Внимание"
                    Exit Sub
                End If
                lastRowBazaSht = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                .Cells(lastRowBazaSht, 1).Resize(UBound(arrData), 4).Value = arrData
            End With
        End If
    Next Sht
    
    MsgBox "Сбор данных завершён!" & vbNewLine & "Данные собраны с " & SheetsCount & " листов", vbInformation, "Конец"
End Sub

Изменено: Михаил О. - 20.08.2020 22:21:27
Я не Михаил...
Макрос по копированию и переносу выделенных ячеек на другой лист
 
Игнорировать можно хоть все)
можно например, проверять, если название листа содержит "Лист", то берём с него данные. А разные другие листы с другими названиями игнорируем
Я не Михаил...
Макрос по копированию и переносу выделенных ячеек на другой лист
 
Всё можно. Только нужно придумать какой-нибудь обход.
Для примера, лист куда мы копируем назвать не просто как у вас "Лист2", а например, "Отчёт", то в макросе можно прописать цикл по всем листам в файле, игнорируя лист Отчёт. Если так подойдёт, то  в вашем файле переименуйте Лист2 на Отчёт, и добавьте 2-3 листа с которых мы будем брать данные (это чтобы я тестировал свой макрос), а я вечером доработаю макрос под ваш пример. Макрос будет брать данные со всех листов, кроме листа Отчёт. И тогда не важно сколько будет листов в файле, хоть 100, макрос будет с них переносить данные в лист Отчёт
Изменено: Михаил О. - 20.08.2020 19:43:12
Я не Михаил...
Макрос по копированию и переносу выделенных ячеек на другой лист
 
Вот так? См. файл
Я не Михаил...
Макрос по копированию и переносу выделенных ячеек на другой лист
 
Так, Сергей, спокойно))
См. файл. Такой макрос подойдёт? Для запуска макроса нажмите Alt+F8

Аа, ещё Экономия (-), перерасход (+) тоже надо перенести, да?
Изменено: Михаил О. - 20.08.2020 18:48:12
Я не Михаил...
Макрос по копированию и переносу выделенных ячеек на другой лист
 
Сергей, в вашем файле нет листа с названием "Лист", в файле есть листы "Лист1", "Лист2", "Лист3"
Жёлтые ячейки есть на "Лист2" и на "Лист3".
А что делать с "Лист1" и таблицей на ней?
Вам надо жёлтые ячейки с "Лист3" перенести на "Лист2" ?

P.S. ну, почему люди выкладывают файл с примером и пишут - посмотрите лист "Заказ". Открываешь файл, а там нет листа "Заказ", но есть другие 5 листов, которые не имеют к вопросу никакого отношения.... я буду в Гаагу жаловаться!
Изменено: Михаил О. - 20.08.2020 18:15:49
Я не Михаил...
Перебор нескольких изменяемых параметров данных и запись всех результатов в новые таблицы., при изменяемых исходных данных нужно получить ВСЕ варианты решений
 
Цитата
ADFF написал:
Ничего себе как вы объясняете!
Годы практики ))
Ну, я ещё не научился телепатии по нику человека определять его профессию) Поэтому всем всегда объясняю как "чайникам", а то ответишь коротко, а потом начинается - а у меня не получается, а куда нажать, а где эта кнопка... и тд.)
На мой взгляд тут ничего не нужно у вас переводить в циклы. На всякий случай выложу ваш код сюда, может другие люди подскажут.
Меня смущают ваши таймеры ожидания "в пол-секунды", думаю они не нужны. но и не думаю, что они сильно мешают.

Код
Sub Count1()

    Rem подставляем 3 исходных коэффициента для формул
        Worksheets("SAR").Range("R2").Copy Worksheets("Results").Range("B3")
        Worksheets("SAR").Range("R2").Copy Worksheets("Main").Range("B21")
        Worksheets("SAR").Range("S2").Copy Worksheets("Results").Range("C3")
        Worksheets("SAR").Range("S2").Copy Worksheets("Main").Range("B22")
        Worksheets("SAR").Range("T2").Copy Worksheets("Results").Range("D3")
        Worksheets("SAR").Range("T2").Copy Worksheets("Main").Range("B23")
        
    Rem копируем 1й промежуточный коэффициент из другого места
        Worksheets("Results").Range("A5").Copy Worksheets("Main").Range("B27")
        
    Rem ждем пол-секунды, пока Excel произведет расчеты
        Application.Wait Now + TimeSerial(0, 0, 0.2)
        
    Rem записываем 1й ряд результатов итоговой таблицы № 1
        Worksheets("Main").Range("H22").Copy
        Worksheets("Results").Range("B5").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H23").Copy
        Worksheets("Results").Range("C5").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H27").Copy
        Worksheets("Results").Range("D5").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H19").Copy
        Worksheets("Results").Range("E5").PasteSpecial Paste:=xlPasteValues
    
    Rem копируем 2й промежуточный коэффициент из другого места
        Worksheets("Results").Range("A6").Copy Worksheets("Main").Range("B27")
        
    Rem ждем пол-секунды, пока Excel произведет расчеты
        Application.Wait Now + TimeSerial(0, 0, 0.2)
        
    Rem записываем 2й ряд результатов итоговой таблицы № 1
        Worksheets("Main").Range("H22").Copy
        Worksheets("Results").Range("B6").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H23").Copy
        Worksheets("Results").Range("C6").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H27").Copy
        Worksheets("Results").Range("D6").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H19").Copy
        Worksheets("Results").Range("E6").PasteSpecial Paste:=xlPasteValues

    Rem копируем 3й промежуточный коэффициент из другого места
        Worksheets("Results").Range("A7").Copy Worksheets("Main").Range("B27")
        
    Rem ждем пол-секунды, пока Excel произведет расчеты
        Application.Wait Now + TimeSerial(0, 0, 0.2)
        
    Rem записываем 3й ряд результатов итоговой таблицы № 1
        Worksheets("Main").Range("H22").Copy
        Worksheets("Results").Range("B7").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H23").Copy
        Worksheets("Results").Range("C7").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H27").Copy
        Worksheets("Results").Range("D7").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H19").Copy
        Worksheets("Results").Range("E7").PasteSpecial Paste:=xlPasteValues
        
    Rem копируем 4й промежуточный коэффициент из другого места
        Worksheets("Results").Range("A8").Copy Worksheets("Main").Range("B27")
        
    Rem ждем пол-секунды, пока Excel произведет расчеты
        Application.Wait Now + TimeSerial(0, 0, 0.2)
        
    Rem записываем 4й ряд результатов итоговой таблицы № 1
        Worksheets("Main").Range("H22").Copy
        Worksheets("Results").Range("B8").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H23").Copy
        Worksheets("Results").Range("C8").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H27").Copy
        Worksheets("Results").Range("D8").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H19").Copy
        Worksheets("Results").Range("E8").PasteSpecial Paste:=xlPasteValues
        
    Rem копируем 5й промежуточный коэффициент из другого места
        Worksheets("Results").Range("A9").Copy Worksheets("Main").Range("B27")
        
    Rem ждем пол-секунды, пока Excel произведет расчеты
        Application.Wait Now + TimeSerial(0, 0, 0.2)
        
    Rem записываем 5й ряд результатов итоговой таблицы № 1
        Worksheets("Main").Range("H22").Copy
        Worksheets("Results").Range("B9").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H23").Copy
        Worksheets("Results").Range("C9").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H27").Copy
        Worksheets("Results").Range("D9").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H19").Copy
        Worksheets("Results").Range("E9").PasteSpecial Paste:=xlPasteValues
        
    Rem копируем 6й промежуточный коэффициент из другого места
        Worksheets("Results").Range("A10").Copy Worksheets("Main").Range("B27")
        
    Rem ждем пол-секунды, пока Excel произведет расчеты
        Application.Wait Now + TimeSerial(0, 0, 0.2)
        
    Rem записываем 6й ряд результатов итоговой таблицы № 1
        Worksheets("Main").Range("H22").Copy
        Worksheets("Results").Range("B10").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H23").Copy
        Worksheets("Results").Range("C10").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H27").Copy
        Worksheets("Results").Range("D10").PasteSpecial Paste:=xlPasteValues
        Worksheets("Main").Range("H19").Copy
        Worksheets("Results").Range("E10").PasteSpecial Paste:=xlPasteValues
            
End Sub
Изменено: Михаил О. - 20.08.2020 18:08:00
Я не Михаил...
Как удалить строчки под фильтром, кроме определённых?
 
Акмал Мухитдинов, данный макрос не запускается человеком. Данный макрос находится в модуле какого-то одного листа и отслеживает изменение выделения ячеек.
Как только вы выделяете ячейку в 3-м столбце сразу макрос начинает работать
Я не Михаил...
Перебор нескольких изменяемых параметров данных и запись всех результатов в новые таблицы., при изменяемых исходных данных нужно получить ВСЕ варианты решений
 
Цитата
ADFF написал:
Я пока даже не смог скопировать текст из окна редактора  в блокнот... Мда... Кракозябры там получаются, а как кодировку править - не нашел.
1. перед копированием (перед тем как нажать Ctrl+C) в редакторе кода переключитесь на русский язык (у меня на компе это левый ALT+Shift), чтобы в правом нижнем углу экрана (где часики) у вас было написано RU, а не EN и дальше копируйте - никаких "кракозяблей" не будет

2. Вместо слова "REM" в модуле можете ставить апостроф и писать дальше ваш комментарий. Апостроф это знак '  (на английском языке русская буква Э на клавиатуре)
Код
Sub Test()

' вот мой комментарий с апострофом в начале строки

End Sub
3. В самом начале вашего кода перед первым копированием добавьте строку
Код
Application.ScreenUpdating = False

а после последнего копирования добавьте строку
Код
Application.ScreenUpdating = True 

это отключит визуализацию на время выполнения макроса, т.е. экран замрёт на время выполнения макроса. Так лучше и макрос быстрее выполняется
Изменено: Михаил О. - 20.08.2020 16:44:43
Я не Михаил...
Cвести данные из колонки А с двух станиц в колонку А третьей страницы
 
Да, попробуйте так

Код
Sub Макрос1()
Dim lastRow As Long
 
    Worksheets("Sheet3").Columns(1).Clear 'вот тут вместо Cells вписал Columns(1)
    With Worksheets("Sheet1")
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.[A1], .Cells(lastRow, 1)).Copy Worksheets("Sheet3").Range("A1")
    End With
     
    With Worksheets("Sheet2")
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.[A2], .Cells(lastRow, 1)).Copy Worksheets("Sheet3").Cells(Worksheets("Sheet3").Cells(.Rows.Count, 1).End(xlUp).Row, 1)
    End With
     
    With Worksheets("Sheet3")
        .Range("A1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes 'удаляем дубли
        .Range("A1").CurrentRegion.Sort .Cells(1, 1), xlAscending, Header:=xlYes 'сортируем
    End With
     
    MsgBox "Сделано!", vbInformation, "Конец"
End Sub
Изменено: Михаил О. - 20.08.2020 15:32:37
Я не Михаил...
Перебор нескольких изменяемых параметров данных и запись всех результатов в новые таблицы., при изменяемых исходных данных нужно получить ВСЕ варианты решений
 
)) ну я думаю остальные уже не сильно помогут. Это только если на массивы вы переводить, без обращения к ячейкам
Изменено: Михаил О. - 20.08.2020 13:33:26
Я не Михаил...
Cвести данные из колонки А с двух станиц в колонку А третьей страницы
 
Игорь, а зачем ArrayList? Может просто скопировать два списка один под другим, удалить дубликаты и отсортировать его по возрастанию, не? Я имею ввиду вот так

Код
Sub Макрос1()
Dim lastRow As Long

    Worksheets("Sheet3").Cells.Clear
    With Worksheets("Sheet1")
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.[A1], .Cells(lastRow, 1)).Copy Worksheets("Sheet3").Range("A1")
    End With
    
    With Worksheets("Sheet2")
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.[A2], .Cells(lastRow, 1)).Copy Worksheets("Sheet3").Cells(Worksheets("Sheet3").Cells(.Rows.Count, 1).End(xlUp).Row, 1)
    End With
    
    With Worksheets("Sheet3")
        .Range("A1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes 'удаляем дубли
        .Range("A1").CurrentRegion.Sort .Cells(1, 1), xlAscending, Header:=xlYes 'сортируем
    End With
    
    MsgBox "Сделано!", vbInformation, "Конец"
End Sub
Изменено: Михаил О. - 20.08.2020 12:38:18
Я не Михаил...
Перебор нескольких изменяемых параметров данных и запись всех результатов в новые таблицы., при изменяемых исходных данных нужно получить ВСЕ варианты решений
 
ADFF, Дополню чуть код от buchlotnik добавив в него отключение визуализации. Код будет работать чуть быстрее.

Код
Sub g()
    Application.ScreenUpdating = False 'добавил
    For i = 1 To 10
        [H5] = [B3].Offset(i, 0)
        For j = 1 To 10
            [I5] = [C3].Offset(j, 0)
            For k = 1 To 10
                [J5] = [D3].Offset(k, 0)
                Application.Calculate
                r = r + 16
                [G4:J18].Copy
                [G4].Offset(r, 0).PasteSpecial xlPasteValues
            Next k
        Next j
    Next i
    Application.ScreenUpdating = True 'добавил
    MsgBox "Done!"
End Sub
Изменено: Михаил О. - 20.08.2020 12:03:59
Я не Михаил...
[ Закрыто] Макросом собрать в умную таблицу определенные строки из других идентичных таблиц разных файлов
 
Добрый день.
вот сортировка по столбцу В (дата)
поставьте эту строку перед сортировкой, котора, уже есть в коде (между строками 50 и 51)

Код
.Range("A1").CurrentRegion.Sort Cells(1, 2), xlAscending, Header:=xlYes 'сортировка дат
Изменено: Михаил О. - 20.08.2020 10:35:46
Я не Михаил...
Оставить строки, в которых есть хотя бы одно из двух заданных значений
 
В Редактор запроса Power Query. Можете посмотреть 2-3 урока на YouTube
Изменено: Михаил О. - 19.08.2020 19:59:32
Я не Михаил...
Сравнить два столбца на разных листах, вывести совпавшие значения
 
Попробуйте формулу ВПР()
К большой таблице подтяните данные из маленькой
Если сложно, то выложите небольшой пример в Excel файле, мы вам сами вставим формулу в ячейку и протянем
Изменено: Михаил О. - 19.08.2020 21:50:12
Я не Михаил...
Страницы: 1 2 След.
Наверх