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

Страницы: 1
Наибольшее значение среди повторяющихся, Присвоить заданный балл наибольшему значению среди повторяющихся
 
Здравствуйте, помогите присвоить 10 баллов всем наибольшим значениям в выборке, учитывая, что наибольших значений несколько.
И далее по убыванию - всем вторым по уменьшению значениям 9 баллов и т.д.
Функция РАНГ присваивает не 10 баллов, а 7 и далее 5..., т.е. не так как нужно.
Файл прикреплен - как считает РАНГ и как нужно (вбито руками).
Спасибо!
Как протянуть значения ячейки вниз по заданным параметрам
 
Добрый день! Задача протягивать значения ячейки вниз по заданным константам.
Через рекордер это выглядит вот так:
Код
Selection.AutoFill Destination:=Range("A1:A10")

А необходимо вместо А1 и А10 задать константы, но код выдает ошибку ((
Пытаюсь сделать вот так:
Код
Selection.AutoFill Destination:=Range("A" & const : "A" & const + const2)

Ругается на двоеточие "Compile error: Expected: list separator or)"
Что я делаю не так?
Изменено: gerbera - 14.11.2017 14:37:41
Поиск по числу в таблице буквы из последнего столбца
 
Добрый день! Помогите справиться с ИНДЕКС+ПОИСКПОЗ - нужно найти по числу в таблице букву из последнего столбца.
Все описание во вложенном файле.
Может у кого-то есть более простое решение чем то, которым пытаюсь решить я.
Запуск макроса из другой книги
 
Добрый день, подскажите, почему первый макрос работает, а второй не работает?
Первый, работает:
Код
Sub macros
Workbooks.Open Filename:="C:\Users\Книга1.xlsb"
Application.Run"'Книга1.xlsb'!macros222"
ActiveWindow.Close False
End Sub


Второй, не работает:
Код
Sub macros
Zapad=ThisWorkbook.Sheets("adres").Range("A1")
Windows(Zapad).Activate
Application.Run"'Книга1.xlsb'!macros222"
ActiveWindow.Close False
End Sub


Мне необходимо использовать второй, где адрес файла прописан в ячейке, а не в коде
Изменено: gerbera - 27.10.2017 13:22:16
Математическое округление в VBA
 
Добрый день! Подскажите, почему формула ROUND при расчете в коде VBA округляет неверно? И как это исправить? Прилагаю файл с расчетом с помощью кода и с помощью формулы.
Код
  Function formula(arg, minvp, minoc, normvp, normoc, maxvp, maxoc As Variant) As Variant
  If (arg > normvp) And (arg <= maxvp) Then formula = Round(normoc + ((arg - normvp) / (maxvp - normvp) * (maxoc - normoc)), 2)
  End Function
Активация книги, имя которой указано в ячейке
 
Добрый день, подскажите, как изменить строку кода, чтобы макрос активировал не файл указанный в нем, а файл, указанный в ячейке A1
Код
Workbooks("Книга1.xlsx").Activate
Как удалить папку со всем содержимым
 
Добрый день! Подскажите, как удалить папку со всем содержимым. Перепробовала кучу способов, но ни один не работает. Прилагаю макрос, с помощью которого удаляю файлы, а как его переделать под удаление папки не пойму

Код
Sub KillDir()
    Dim sDirName As String
 
    sDirName = "C:\Рабочий стол\Папка для удаления" ' для удаления файла добавляю имя файла
 
    If Dir(sDirName, 16) = "" Then MsgBox "Нет такой папки", vbCritical, "Ошибка": Exit Sub
 
    Kill sDirName
End Sub
.
Редактирование всех файлов во всех подпапках
 
Добрый день! Есть макрос, который редактирует все файлы в выбранной папке (меняет цвет текста в указанной ячейке). Подскажите, как дополнить код, чтобы редактирование происходило не только в файлах в выбранной папке, а и во всех файлах во всех подпапках в выбранной папке.
Спасибо!
Код
Sub NoColor()
    Dim sFolder As String, sFiles As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    
    Application.ScreenUpdating = False
    
    sFiles = Dir(sFolder & Application.PathSeparator & "*.xlsb*")
    Do While sFiles <> ""
        Application.Workbooks.Open sFolder & "\" & sFiles, False
        Range("J60").Select
        With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        End With
        ActiveWorkbook.Save
        ActiveWindow.Close
        sFiles = Dir
    Loop
    
    Application.ScreenUpdating = True

End Sub
Изменено: gerbera - 27.07.2017 11:52:18
Не видно файлы при запуске макроса открытия
 
Добрый день! Подскажите, почему не видно файлы при запуске этого макроса? При обычном открытии через Файл-Открыть все файлы видны
Код
Sub NoColor()
    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)
    sFiles = Dir(sFolder & "*.xlsb*")
    Do While sFiles <> ""
        Workbooks.Open sFolder & sFiles

        'Далее идут действия с файлом

     

Изменено: gerbera - 21.12.2016 17:03:44
Вырезать текст от первого до последнего символа
 
Добрый день! Два дня перерываю форум, перепробовала кучу формул, но так и получилось то, что нужно. А нужно следующее: есть текст с нижними подчеркиваниями, но нужно вырезать текст после первого и до последнего (не второго, а именно последнего, так как их несколько).
Примеры:
Пушкин_Начальник_Иванов Иван.xls (оставить Начальник)
Пушкин_Начальник_Отдел_Петров Сергей Сергеевич.xls (оставить Начальник_Отдел)
Королев_Нач_Отд_Прим_Сидоров.И.И.xls (оставить Нач_Отд_Прим)
Переход к следующему файлу если данного нет в списке
 
Добрый день! Помогите разобраться что не так с макросом. Есть список адресов файлов на листе "name" в строках cо 2 по kolvo и 24 колонке. Макросом открывается каждый файл и копирует в рядом стоящую ячейку (cells(I,20)) значение из ячейки J50. Проблема в том, что не все файлы, перечисленные в списке, есть на месте. Как сделать так, чтобы отсутствующие файлы макрос пропускал и приступал к следующему? GoTo z: почему-то работает только на первом отсутствующем файле, а на следующем выдает ошибку, что файла нет.
Код
Sub макрос()
Dim I As Integer
kolvo = ThisWorkbook.Sheets("summa").Range ("A1")
For i = 2 to kolvo
        Sheets("name").Select
        Workbooks.Open Filename:=Cells(i,24)
        On Error GoTo z:
        Range("J50").Select
        Application.CutCopyMode = False
        Selection.Copy
        Windows("Raschet.xls").Activate
        Range (Cells(i,20)).Select
         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
          Workbooks(Cells(i,6).Value).Activate
           ActiveWindow.Close False
z:
Next i
End Sub
Функция vba тестовая или числовая
 
Добрый день! Помогите преобразовать функцию vba с условием что если arg числовой, то и значение test числовое, а если текстовый, то и значение текстовое ("нет"). Мои предположения выделила апострофом '  но они не работают :(
Код
Function test (arg As Double) As Double
  'Function test (arg As String) As String
If arg = 0 Then test = 1
If arg = 1 Then test = 2
If arg > 1 Then test = 3
  'If arg = "нет" Then test =  "нет"
End Function
Страницы: 1
Наверх