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)}.
Как решить эту задачу?Как описать условие?