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
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
Ну зачем так усложнять, 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
Ну зачем так усложнять, VBA это не только эксель, и ворд сильно удивиться когда его попросят worksheetfunction
Мне как раз нужно написать в экселе эту программу.
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, ... - вариантов много.
А попроще никак нельзя сделать?
Лена, за попроще это вы не туда зашли. Здесь легких путей не ищут.
- Бесплатные приложения для трейдинга
- 8 000+ сигналов для копирования
- Экономические новости для анализа финансовых рынков
Вы принимаете политику сайта и условия использования
Даны числа a, b, c, d. Найти min { max (a, b), max (c, d)}.
Как решить эту задачу?Как описать условие?