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

Страницы: 1 2 След.
Как протянуть формулу в столбце кроме определенных ячеек
 
Спасибо Вам большое заработало, разобрался я это "FormulaLocal" заменил на "FormulaR1C1"
Как протянуть формулу в столбце кроме определенных ячеек
 
Почти так, только вот формула ссылается всегда на "B8"
Как протянуть формулу в столбце кроме определенных ячеек
 
А можно как-то макросом скопировать Формулу только в те строки где нет слова "Всего"?
Как протянуть формулу в столбце кроме определенных ячеек
 
Цитата
написал:
А попробуйте протянуть эту формулу
Просто смысл, в том что там уже есть формулы и их  надо как-то обойти
Изменено: Lerik2020 - 23.11.2023 22:28:07
Как протянуть формулу в столбце кроме определенных ячеек
 
А как-то можно, в макросе указать один диапазон?, потому что-то в разных местах домазаны могут быть разные.
Как протянуть формулу в столбце кроме определенных ячеек
 
Не понял, это как?
Изменено: Lerik2020 - 23.11.2023 20:57:37
Как протянуть формулу в столбце кроме определенных ячеек
 
Здравствуйте, помогите дописать макрос. Получается макрос протягивает формулу в столбце "C" ориентируясь на столбец "B", т.е. где заканчивается заполненные ячейки, формула перестаёт протягиваться. Как сделать, чтобы формула  не заполнялась в столбце "C", где в ячейке присутствует слово "Всего"?
Изменено: Lerik2020 - 23.11.2023 20:57:04
Как объединить ячейки ориентируясь на заполненные ячейки справа
 
Sanja, Ваш код почему-то не сработал
Как объединить ячейки ориентируясь на заполненные ячейки справа
 
Behruz A.N, спасибо Вам большое за помощь)))
Как объединить ячейки ориентируясь на заполненные ячейки справа
 
Здравствуйте помогите пожалуйста с макросом. Как объединить ячейки ориентируясь на заполненные ячейки справа То есть, если у меня в столбце "D" ячейки заполнены с "D1:D8", то в столбце "E", нужно объединить ячейки с "E1:E8" и если  можно, то ещё применить обводку объединённых ячеек. Пример прикладываю.
Как макросом отчистить ячейки по условию
 
Спасибо, забыл про свой вопрос, поэтому не своевременно по благодарил. А, можно подправить, чтобы выполнял тоже самое, но где есть набор определенных символов например "!%?"
Результат числа зависит от сколько знаков после запятой в погрешности
 
Ну а в посте №4, откуда взяли формулу, там нет ссылки "D14", "E14" из моего первого примера. Во вложенном примере из поста №12 я ошибся указав на формулу из ячейки "P16", смотрите результат  из ячейки "P15"
Цитата
tutochkin написал:
А можно сделать пример с тремя ячейками.
Надо в одной ячейки
Результат числа зависит от сколько знаков после запятой в погрешности
 
Во первых, Вы вытащили мою формулу и вставили к себе в файл, не обратив внимания на, то что она еще ссылается на ячейки "D14", "E14" (границы), эта уже отклонение от моей формулы. Вообщем картинку прикрепил, с "5,2" и "5,6" всё считает, не знаю почему у Вас не считает. Если будете работать вот файл работайте в нём. А Ваше второе предложение с формулой "Если хочется без VBA, то вот такая строка:", это длинная
Результат числа зависит от сколько знаков после запятой в погрешности
 
Подправил чуть-чуть, всё сходиться
Результат числа зависит от сколько знаков после запятой в погрешности
 
Цитата
Что то у меня оба предложенных варианта не заработали как требуется.
Вот пример
Изменено: Lerik2020 - 28.10.2021 13:46:00
Результат числа зависит от сколько знаков после запятой в погрешности
 
Я, так понимаю здесь надо еще до думать, это перевести формулы с английского на русский заменить "4,6" и "1,3" на формулы чтобы получить формулу следующего вида
Скрытый текст
Если так, то спасибо
Результат числа зависит от сколько знаков после запятой в погрешности
 
Здравствуйте, нужна помощь в написании формулы. На примере №1 объясню, если результат равняется "5", а погрешность "1,3", то запись должна быть "5,0±1,3",то есть если у погрешности после запятой есть знак, то число нужно выводить то же после запятой знак. Примере №2 , если результат равняется "5", а погрешность "1", то запись должна быть "5±1, Примере №3 , если результат равняется "4,6", а погрешность "1", то запись должна быть "4,6±1,0. Погрешность может быть разные цифры, это я так в пример привел, не обязательно "1,3" или "1", также и в числе. Я смог реализовать  получить нужный результат, но слишком много формул пришлось создать. Может у кого то по короче получиться.
Как макросом отчистить ячейки по условию
 
Здравствуйте подскажите пожалуйста. Как макросом отчистить ячейки по условию. Например в столбце "B:B" имеются такие записи ("№ договора", "от какого числа", "протокол № ", "Дата и время", а в столбце "C:C", идет заполнение. Можно ли ориентируясь на столбца "B:B" очистить заполнение в столбце "C:C". Можно фиксированно конечно сделать, какие ячейки отчистить, а если скажем строки по едут на одну сместятся, верх или вниз, то геморройно будет опять перебивать в какие ячейки отчистить от информации .

Или может просто выделить определенный столбец в котором будет символы например "$%@^", то ячейки из столбца "C:C" очистить. Например если в ячейка "B11" есть эти символы "$%@^", то ячейку "C11" отчистить от информации, наверно так проще будет.
Как из одной ячейки исключить слова находящиеся в других ячейках
 
Msi2102, да Вы правы, забыл написать, дошло что надо писать так "=СцепитьМного(B13:K13;"; "&СИМВОЛ(10);1;O13:X13)"
Как из одной ячейки исключить слова находящиеся в других ячейках
 
НУ да, ооочень круто, спасибо. А еще один вопрос, а если у меня сцепляет вот такого типа формулы "=ЕСЛИ(C6="";"";C6&СИМВОЛ(10))"", то тогда разделитель ставиться в начале, а не в конце. Ну это не критично, но все же может быть можно, сделать, чтобы он прописывался в конце. Я сделал так эту формулу, чтобы после сцепления Показывался весь текст ни одной строкой, а типа через ALT+ENTER
Как из одной ячейки исключить слова находящиеся в других ячейках
 
А со "сцепить много", как то можно подружить Вашу функцию?
Как из одной ячейки исключить слова находящиеся в других ячейках
 
Здравствуйте, подскажите пожалуйста как из одной ячейки исключить слова находящиеся в других ячейках. У меня в ячейка "B13:K13", находятся текст который сцепляется функцией "сцепитьмного", взял отсюда, теперь нужно исключить слова из этой функции, которые находятся в ячейках "O13:X13". Можно конечно воспользоваться функцией "подставить", но это нужно прописывать для каждой ячейки. Есть какой-нибудь способ по короче?
Поиск в выпадающем списке с выводом двух значений
 
Странное понятие у Вас о детских вопросах, вы не по адресу. Я разобрался. Вот код может кому надо будет.
Код
Option Explicit
Option Compare Text

Private Sub Comm1_Click()
    Dim r As Integer, C As Integer
    If ListBox1.ListIndex = -1 Then Exit Sub
    If Not ActiveSheet Is iSheetLists Then
        If ActiveSheet.ProtectContents = True And ActiveCell.Locked = True Then
            MsgBox "Лист защищен! Что бы вставить значение, снимите защиту листа."
        Else
            ActiveCell.Value = ListBox1.Text
            Select Case iShiftOption
            Case 0: r = 0: C = 0
            Case 1: r = -1: C = 0
            Case 2: r = 0: C = 1
            Case 4: r = 0: C = -1
            Case Else: r = 1: C = 0
            End Select
            On Error Resume Next
            'AppActivate "Microsoft Excel"
            ActiveCell.Offset(r, C).Activate
            ListBox1.SetFocus
            On Error GoTo 0
        End If
    End If
End Sub

Private Sub HelpButton_Click()
    Me.Hide
    With HelpForm
        .Top = Me.Top
        .Left = Me.Left
        .Show
    End With
    Me.Show
End Sub

Private Sub ListBox1_Click()
    Call MyControlsState(Not ListBox1.ListIndex = -1)
    NewItButton.Enabled = Not TextBoxItems.Text = ""
End Sub

Private Sub ListBoxItems_Click()
Dim arr, i As Long, MainValue As String
 
    If Me.ListBoxItems.ListCount = 0 Then Exit Sub
    arr = Worksheets("Список").Range("A1").CurrentRegion.Value
    For i = 0 To Me.ListBoxItems.ListCount - 1
        If Me.ListBoxItems.Selected(i) Then
            MainValue = Me.ListBoxItems.List(i)
            Exit For
        End If
    Next
    If MainValue = "" Then Exit Sub
    Me.ListBox1.Clear
    For i = 1 To UBound(arr)
        If arr(i, 1) = MainValue Then Me.ListBox1.AddItem arr(i, 2)
    Next i
End Sub

'----------------------------------------------------------
'----------------------------------------------------------

Private Sub UserForm_Initialize()
    Me.Tag = 1
    Me.Caption = AppName
    If iMainFormPosOption = 1 Then Call mySetFormKoord(Me)    ' устанавливаем координаты формы
    Call AssigningValuesToVariables    ' присваиваем значения переменным
    Call MyFillDataControlLists(ComboBoxLists)    ' заполняем данными комбобокс с названиями списков и устанавливаем в нем текущий єлемент.
    If dLists.Count = 0 Then
        MsgBox "Нет списков для выбора!" & vbCrLf & "Для продолжения работы добавьте хотя бы один список." _
               , vbExclamation + vbOKOnly, AppName
        SettingsForm.Show
        Call MyFillDataControlLists(ComboBoxLists)
    End If
End Sub

Private Sub AssigningValuesToVariables()
    Call myGetCustomProperties("NumListColumn", 1, iNumListColumn)
    Call myGetCustomProperties("SortingOption", 1, iSortingOption)
    Call myGetCustomProperties("ShiftOption", 3, iShiftOption)
    Call myGetCustomProperties("DblClickRunOption", 1, iDblClickRunOption)
    Call myGetCustomProperties("FindOption", 1, iFindOption)
    Call myGetCustomProperties("MainFormPosOption", 1, iMainFormPosOption)
End Sub

Private Sub myGetCustomProperties(prName As String, prValueDefault As Long, prValue As Long)
    On Error Resume Next
    With ThisWorkbook.CustomDocumentProperties
        If Not MyCustomPropertiesExists(prName) Then _
           Call MyCreateCustomProperties(prName, prValueDefault)
        prValue = CLng(.Item(prName))
        If Not Err.Number = 0 Then prValue = prValueDefault
    End With
    On Error GoTo 0
End Sub

Private Sub ComboBoxLists_Change()
    Dim s
    TextBoxItems.Text = ""
    ListBoxItems.Clear
    If ComboBoxLists.Text = "" Then Exit Sub
    s = ComboBoxLists.Text
    If IsNumeric(s) Then s = Val(s)
    iNumListColumn = dLists.Item(s)
    Call MyFillDataControlItems(ListBoxItems)
End Sub

Private Sub ListBoxItems_Change()
    Call MyControlsState(Not ListBoxItems.ListIndex = -1)
    NewItButton.Enabled = Not TextBoxItems.Text = ""
End Sub
Private Sub MyControlsState(ContrlState As Boolean)
    OKButton.Enabled = ContrlState
    DelItButton.Enabled = ContrlState
    NewItButton.Enabled = ContrlState
End Sub
Private Sub MyControlsState22(ContrlState As Boolean)
    Comm1.Enabled = ContrlState
    DelItButton.Enabled = ContrlState22
    NewItButton.Enabled = ContrlState22
End Sub
Private Sub TextBoxItems_Change()
    Dim s As String, it
    NewItButton.Enabled = Not TextBoxItems.Text = ""
    If ComboBoxLists.Text = "" Or _
       dLists.Count = 0 Then NewItButton.Enabled = False: Exit Sub
    If dItems.Count = 0 Then Exit Sub
    ListBoxItems.Clear
    If TextBoxItems.Text = "" Then
        ListBoxItems.List = dItems.keys
    Else
        s = "*" & TextBoxItems.Text & "*"
        If iFindOption = 2 Then s = Mid(s, 2)
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For Each it In dItems.keys
                If it Like s Then .Item(it) = ""
            Next it
            If .Count = 0 Then Exit Sub
            ListBoxItems.List = .keys
        End With
    End If
    ListBoxItems.ListIndex = 0
End Sub

Private Sub CancelButton_Click()
    Unload Me
End Sub

Private Sub ComboBoxLists_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = 0
End Sub

Private Sub DelItButton_Click()
    Dim r As Range
    If MsgBox("Вы действительно хотите удалить" & vbCrLf & "элемент: " & _
              ListBoxItems.Text & vbCrLf & "из списка: " & ComboBoxLists.Text & " ?", vbOKCancel + vbExclamation, _
              "Удаление элемента списка") = vbOK Then
        With iSheetLists.Columns(iNumListColumn)
            On Error Resume Next
            Set r = .Find(What:=ListBoxItems.Text, LookIn:=xlValues, LookAt:=xlWhole)
            If Not r Is Nothing Then r.Delete Shift:=xlUp
        End With
        dItems.RemoveAll
        TextBoxItems.Text = ""
        Call MyFillDataControlItems(ListBoxItems)
    End If
End Sub

Private Sub ListBoxItems_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call OKButton_Click
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call Comm1_Click
End Sub
Private Sub NewItButton_Click()
    Dim s
    s = TextBoxItems.Text
    If IsNumeric(s) Then s = Val(s)
    If Len(Trim(s)) = 0 Then Exit Sub
    If dItems.Exists(s) Then
        MsgBox "Элемент: " & s & vbCrLf & "уже есть в этом списке !"
        Exit Sub
    End If
    With iSheetLists
        On Error Resume Next
        .Cells(.Rows.Count, iNumListColumn).End(xlUp).Offset(1, 0).Value = s
    End With
    dItems.RemoveAll
    TextBoxItems.Text = ""
    Call MyFillDataControlItems(ListBoxItems, s)
End Sub

Private Sub OKButton_Click()
    Dim r As Integer, C As Integer
    If ListBoxItems.ListIndex = -1 Then Exit Sub
    If Not ActiveSheet Is iSheetLists Then
        If ActiveSheet.ProtectContents = True And ActiveCell.Locked = True Then
            MsgBox "Лист защищен! Что бы вставить значение, снимите защиту листа."
        Else
            ActiveCell.Value = ListBoxItems.Text
            Select Case iShiftOption
            Case 0: r = 0: C = 0
            Case 1: r = -1: C = 0
            Case 2: r = 0: C = 1
            Case 4: r = 0: C = -1
            Case Else: r = 1: C = 0
            End Select
            On Error Resume Next
            'AppActivate "Microsoft Excel"
            ActiveCell.Offset(r, C).Activate
            ListBoxItems.SetFocus
            On Error GoTo 0
        End If
    End If
End Sub

Private Sub SettingsButton_Click()
    Call MyControlsState(False)
    Me.Hide
    SettingsForm.Show
    ListBoxItems.Clear
    Call MyFillDataControlLists(ComboBoxLists)
    If Not dLists.Count = 0 Then
        Call MyFillDataControlItems(ListBoxItems)
    End If
    TextBoxItems.Text = ""
    Me.Show 0
End Sub

Private Sub UserForm_Terminate()
    Call mySetCustomProperties("NumListColumn", iNumListColumn)
    Call mySetCustomProperties("SortingOption", iSortingOption)
    Call mySetCustomProperties("ShiftOption", iShiftOption)
    Call mySetCustomProperties("DblClickRunOption", iDblClickRunOption)
    Call mySetCustomProperties("FindOption", iFindOption)
    Call mySetCustomProperties("MainFormPosOption", iMainFormPosOption)

    Set dLists = Nothing
    Set dItems = Nothing
 
End Sub

Private Sub mySetCustomProperties(prName As String, prValue As Long)
    On Error Resume Next
    With ThisWorkbook.CustomDocumentProperties
        If MyCustomPropertiesExists(prName) Then
            .Item(prName).Value = prValue
        Else
            Call MyCreateCustomProperties(prName, prValue)
        End If
    End With
    On Error GoTo 0
End Sub
Изменено: Lerik2020 - 22.07.2020 00:03:55
Поиск в выпадающем списке с выводом двух значений
 
Да то что нужно, спасибо огромнейшее!!! Подскажите, а как сделать чтобы он еще в ячейку вставлял???
Поиск в выпадающем списке с выводом двух значений
 
Извините, вот файл
Изменено: Lerik2020 - 21.07.2020 17:41:39
Поиск в выпадающем списке с выводом двух значений
 
Здравствуйте помогите сделать поиск в выпадающем списке с выводом двух значений? В прилагаемом примере поиск осуществляется по одному списку взяты с определенного столбца "A:A" и безв повторяющегося значения. А нужно чтобы он выводил в одном окне весь список из столбца "A:A", а во втором окне весь список из столбца "B:B". Например надо найти "Метан", ввожу его и нужно чтобы в первом оне вышли все варианты "Метан" из столбца "A", а во втором окне список из столбца "B" варианты которые расположены на против их, то есть например "A10" соответствует "B10"
Отправка файлов по электронной почте находящихся в одном файле
 
Макрос запускает outlook с прикрепленными файлами, я нажимаю отправить, outlook закрывается, но ни чего не приходит. Приходится вручную запускать outlook, и только после этого письмо приходит
Отправка файлов по электронной почте находящихся в одном файле
 
Вот сделал как Вы и сказали, outlook выполняет отправку но, ни чего не приходит. У меня в папке два файла, outlook дважды запускается, получается он пытается отправить два письма, и если в папке будет 10 файлов, столько же раз отправит. А одним разом как то можно сделать?
Код
Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'отключаем обновление экрана, чтобы наши действия не мелькали
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        'открываем книгу
        Workbooks.Open sFolder & sFiles
        'действия с файлом
Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
      
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")   'запускаем Outlook в скрытом режиме
    OutApp.Session.Logon      
    On Error GoTo cleanup  'если не запустился - выходим 
    Set OutMail = OutApp.CreateItem(0)   'создаем новое сообщение
    On Error Resume Next
    'заполняем поля сообщения
    With OutMail
        .To = Range("A1").Value
        .Subject = Range("A2").Value
        .Body = Range("A3").Value
        .Attachments.Add Range("A4").Value
        'команду Send можно заменить на Display, чтобы посмотреть сообщение перед отправкой 
        .Send
    End With
  
    On Error GoTo 0
    Set OutMail = Nothing
  
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True

        'Закрываем книгу с сохранением изменений
        ActiveWorkbook.Close True 'если поставить False - книга будет закрыта без сохранения
        sFiles = Dir
    Loop
    'возвращаем ранее отключенное обновление экрана
    Application.ScreenUpdating = True
End Sub
Изменено: Lerik2020 - 05.03.2020 23:31:15
Отправка файлов по электронной почте находящихся в одном файле
 
Не совсем понял как, это сделать?
Отправка файлов по электронной почте находящихся в одном файле
 
Подскажите пожалуйста, а можно ли в этом макросе прописать, чтобы он отправлял ни один файл а все файлы разом находящиеся в одной папке. Макрос взял отсюда
Код
Sub SendMail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
     
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")   'запускаем Outlook в скрытом режиме
    OutApp.Session.Logon      
    On Error GoTo cleanup  'если не запустился - выходим 
    Set OutMail = OutApp.CreateItem(0)   'создаем новое сообщение
    On Error Resume Next
    'заполняем поля сообщения
    With OutMail
        .To = Range("A1").Value
        .Subject = Range("A2").Value
        .Body = Range("A3").Value
        .Attachments.Add Range("A4").Value
        'команду Send можно заменить на Display, чтобы посмотреть сообщение перед отправкой 
        .Send
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub
Страницы: 1 2 След.
Наверх