Скачать MetaTrader 5
Авторизуйтесь или зарегистрируйтесь, чтобы добавить комментарий
Узнай последние события MQL5.community!
Lena
14
Lena 2013.11.16 16:03 

Даны числа a, b, c, d. Найти min { max (a, b), max (c, d)}.

Как решить эту задачу?Как описать условие?

gyfto
251
gyfto 2013.11.16 18:01  
Sub minimax()
    Dim a As Integer: a = 16
    Dim b As Integer: b = 23
    Dim c As Integer: c = 18
    Dim d As Integer: d = 20
    Dim result As Integer: result = Application.WorksheetFunction.Min(Application.WorksheetFunction.Max(a, b), Application.WorksheetFunction.Max(c, d))
    Debug.Print result
End Sub
gyfto
251
gyfto 2013.11.16 18:07  
Function minimax(a As Integer, b As Integer, c As Integer, d As Integer) As Integer
    minimax = Application.WorksheetFunction.Min(Application.WorksheetFunction.Max(a, b), Application.WorksheetFunction.Max(c, d))
End Function
Sub test_minimax()
    Debug.Print minimax(16, 23, 18, 20)
End Sub
Всеволод
648
Всеволод 2013.11.17 09:39  
Ну зачем так усложнять, VBA это не только эксель, и ворд сильно удивиться когда его попросят worksheetfunction
Function minimax(a, b, c, d)
    if a>b then c1=a else c1=b
    if c>d then c2=c else c2=d
    if c1>c2 then minimax=c2 else minimax=c1
End Function
Sub test_minimax()
    Debug.Print minimax(16, 23, 18, 20)
End Sub
gyfto
251
gyfto 2013.11.17 11:40  
Ну зачем так усложнять, VBA это не только эксель, и ворд сильно удивиться когда его попросят worksheetfunction
Не спорю, но я исходил из предположения, что это из задач трейдинга, а в экселе (не в Ворде) аналитику разворачивают многие трейдеры, были бы потоковые данные. Освобожусь, допишу сюда vba-функцию выборочного конвертирования областей листа в csv, где-то у меня валялась, в МТ4 может кому пригодится.
Lena
14
Lena 2013.11.17 13:15  
splxgf:
Мне как раз нужно написать в экселе эту программу.
gyfto
251
gyfto 2013.11.17 15:49  
Sub toCSV()
    On Error Resume Next
    Dim csv_range_beg As Range
    Dim csv_range_end As Range
    Dim csv_range_primary As Range
    Const ChildrenFolder As String = "\csv\"
    CSVfolder$ = ThisWorkbook.Path & ChildrenFolder: MkDir CSVfolder$
        Workbooks.Open filename:=ThisWorkbook.Path & "\NameFile.xlsm"
        CSVfilePrimaryName$ = "NameFile.csv"
        CSVfileIndname$ = "Ind_NameFile.csv"
        
        Set csv_range_beg = Workbooks("NameFile.xlsm").Worksheets("Ind").Range("B3:E12")
        CSVtext_beg$ = Range2CSV_beg(csv_range_beg)
        SaveTXTfile CSVfolder$ & CSVfileIndname$, CSVtext_beg$' записываем в один csv
        
        Set csv_range_end = Workbooks("NameFile.xlsm").Worksheets("Ind").Range("B14:E14")
        CSVtext_end1$ = Range2CSV_end(csv_range_end)
        AddIntoTXTfile CSVfolder$ & CSVfileIndname$, CSVtext_end1$' дописываем в этот csv
        
        Set csv_range_end = Workbooks("NameFile.xlsm").Worksheets("Ind").Range("B15:E15")
        CSVtext_end2$ = Range2CSV_end(csv_range_end)
        AddIntoTXTfile CSVfolder$ & CSVfileIndname$, CSVtext_end2$' ещё раз дописываем в этот csv
        
        Set csv_range_primary = Workbooks("NameFile.xlsm").Worksheets("All").Range("A2:G1357")
        CSVtext_primary$ = Range2CSV_beg(csv_range_primary)
        SaveTXTfile CSVfolder$ & CSVfilePrimaryName$, CSVtext_primary$' записываем в другой csv
        
        Workbooks("NameFile.xlsm").Save
        Workbooks("NameFile.xlsm").Close
End Sub
Private Function SaveTXTfile(ByVal filename As String, ByVal txt As String) As Boolean
    On Error Resume Next: Err.Clear
    Set fso = CreateObject("scripting.filesystemobject")
    Set ts = fso.CreateTextFile(filename, True)
    ts.Write txt: ts.Close
    SaveTXTfile = Err = 0
    Set ts = Nothing: Set fso = Nothing
End Function
Private Function Range2CSV_end(ByRef ra As Range, Optional ByVal ColumnsSeparator$ = ";", _
                   Optional ByVal RowsSeparator$ = vbNewLine) As String
    If ra.Cells.Count = 1 Then Range2CSV_end = ra.Value & RowsSeparator$: Exit Function
    If ra.Areas.Count > 1 Then
        Dim ar As Range
        For Each ar In ra.Areas
            Range2CSV_end = Range2CSV_end & Range2CSV_end(ar, ColumnsSeparator$, RowsSeparator$)
        Next ar
        Exit Function
    End If
    Arr = ra.Value
    chr34$ = Chr(34): buffer$ = "": buffer2$ = "": Const BufferLen& = 15000
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        txt = "": For j = LBound(Arr, 2) To UBound(Arr, 2)
            txt = txt & ColumnsSeparator$ & 100 * CDbl(Arr(i, j))
        Next j
        buffer$ = buffer$ & Mid(txt, Len(ColumnsSeparator$) + 1) & RowsSeparator$
        If Len(buffer$) > BufferLen& Then
            buffer2$ = buffer2$ & buffer$: buffer$ = ""
            If Len(buffer2$) > BufferLen& * 40 Then _
               Range2CSV_end = Range2CSV_end & buffer2$: buffer2$ = "": DoEvents
       End If
    Next i
    Range2CSV_end = Range2CSV_end & buffer2$ & buffer$
End Function
Private Function Range2CSV_beg(ByRef ra As Range, Optional ByVal ColumnsSeparator$ = ";", _
                   Optional ByVal RowsSeparator$ = vbNewLine) As String
    If ra.Cells.Count = 1 Then Range2CSV_beg = ra.Value & RowsSeparator$: Exit Function
    If ra.Areas.Count > 1 Then
        Dim ar As Range
        For Each ar In ra.Areas
            Range2CSV_beg = Range2CSV_beg & Range2CSV_beg(ar, ColumnsSeparator$, RowsSeparator$)
        Next ar
        Exit Function
    End If
    Arr = ra.Value
    chr34$ = Chr(34): buffer$ = "": buffer2$ = "": Const BufferLen& = 15000
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        txt = "": For j = LBound(Arr, 2) To UBound(Arr, 2)
            txt = txt & ColumnsSeparator$ & Arr(i, j)
        Next j
        buffer$ = buffer$ & Mid(txt, Len(ColumnsSeparator$) + 1) & RowsSeparator$
        If Len(buffer$) > BufferLen& Then
            buffer2$ = buffer2$ & buffer$: buffer$ = ""
            If Len(buffer2$) > BufferLen& * 40 Then _
               Range2CSV_beg = Range2CSV_beg & buffer2$: buffer2$ = "": DoEvents
       End If
    Next i
    Range2CSV_beg = Range2CSV_beg & buffer2$ & buffer$
End Function
Private Function AddIntoTXTfile(ByVal filename As String, ByVal txt As String) As Boolean
    On Error Resume Next: Err.Clear
    Set fso = CreateObject("scripting.filesystemobject")
    Set ts = fso.OpenTextFile(filename, 8, True): ts.Write txt: ts.Close
    Set ts = Nothing: Set fso = Nothing
    AddIntoTXTfile = Err = 0
End Function

Вот, реальный пример. Здесь приходилось разделять один эксель на два csv, причём в один из двух csv информация записывалась в три захода, - в первый раз затирая всё предыдущее содержимое (функция SaveTXTfile, с листа выбиралось функцией Range2CSV_beg), а два других раза дописывая в тот же csv (функция AddIntoTXTfile, с листа выбиралось функцией Range2CSV_end). Поскольку время тогда торопило, заботиться о красоте кода было некогда, извините... Макрос toCSV() можно повесить на кнопку (автофигуру) на самом листе, можно назначить горячую клавишу, можно повесить кнопкой на панель инструментов, можно прописать в коде самой книги, чтобы запускался при открытии xlsm, ... - вариантов много.

Lena
14
Lena 2013.11.19 17:25  
А попроще никак нельзя сделать?
Alexey Subbotin
4999
Alexey Subbotin 2013.11.19 17:46  
Lenuschka:
А попроще никак нельзя сделать?

Лена, за попроще это вы не туда зашли. Здесь легких путей не ищут.
/
Авторизуйтесь или зарегистрируйтесь, чтобы добавить комментарий