Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Найти максимальный элемент в массиве и удалить его
 
#1
28.05.2018 09:24:37
Подскажите как осуществить удаление записи, соответствующей самому дорогому виду конфет, их стоймости за 1 кг вводятся с клавиатуры
 
 
 
#2
28.05.2018 09:27:42
Цитата
xotdog8 написал: их стоймости за 1 кг вводятся с клавиатуры
прямо в фотошопе? или другом графическом редакторе? Я это к чему - на форме по Excel уместнее будут файлы в формате Excel (Как есть - Как надо, в Правилах, кстати, об этом написано)
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
28.05.2018 09:34:18
м
Изменено: xotdog8 - 18.06.2018 11:09:13
 
 
 
#4
28.05.2018 09:34:51
Цитата
Sanja написал:
на форме по Excel уместнее будут файлы
Александр, это без сомнения. Но хотелось бы от ТС и ещё смысл фразы
Цитата
xotdog8 написал:
Подскажите как осуществить удаление записи, соответствующей самому дорогому виду конфет, их стоймости за 1 кг вводятся с клавиатуры
получить.
Сейчас на картинке пусто в стоимости 1кг. Если вводим с клавиатуры положительное число, то по идее тут же эту строку с введённым числом и нужно удалить (формально считаем пусто = 0).
Или, если ввели отрицательное число, то тогда удаляем все пустые?
 
 
 
#5
28.05.2018 09:59:20
Цитата
xotdog8 написал:
В VBA как осуществить это
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#6
28.05.2018 10:11:30
Nordheim,  :D  :D  
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#7
28.05.2018 10:37:27
:D . Злые вы  :D . с Днем Пограничника Всех!
Согласие есть продукт при полном непротивлении сторон
 
 
 
#8
28.05.2018 11:42:13
Nordheim,
Написал, нашел максимальный элемент в массиве, не подскажете как теперь удалить строку с этим максимальным элементом?
Код
Private Sub CommandButton2_Click()
Dim maxCENA As Single
Dim KONF(1 To 13) As String
Dim CENA(1 To 13) As Single
Dim SizeM, NomerMax, i, k As Integer
maxCENA = CENA(1)
Worksheets("Ëèñò2").Select
Cells(1, 1) = "Âèä êîíôåò"
Cells(1, 2) = "Ñòîéìîñòü çà 1êã"
For i = 1 To SizeM
Cells(i + 1, 1) = KONF(i)
Cells(i + 1, 2) = CENA(i)
Next i
For i = 1 To SizeM
If i = 1 Then
Worksheets("Ëèñò2").Range("A" & i).Font.FontStyle = "ïîëóæèðíûé"
Worksheets("Ëèñò2").Range("A" & i).HorizontalAlignment = xlCenter
Worksheets("Ëèñò2").Range("B" & i).Font.FontStyle = "ïîëóæèðíûé"
Worksheets("Ëèñò2").Range("B" & i).HorizontalAlignment = xlCenter
End If
Worksheets("Ëèñò2").Range("A" & i).Borders.LineStyle = xlContinuous
Worksheets("Ëèñò2").Range("B" & i).Borders.LineStyle = xlContinuous
If i > 1 Then
Worksheets("Ëèñò2").Range("B" & i).NumberFormat = "0.000"
End If
Next i
For i = 1 To SizeM
If CENA(i) > maxCENA Then
maxCENA = CENA(i): NomerMax = i
End If
Next i
End Sub
 
 
 
#9
28.05.2018 11:49:55
Если NomerMax это номер строки то так:
Код
Rows(NomerMax).Delete
Изменено: Nordheim - 28.05.2018 11:51:15
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#10
28.05.2018 11:58:11
Код не могу разобрать:
1) зачем два цикла по одному массиву?
2) чему равна SizeM?
3) Зачем это  :
Код
If i = 1 Then
Worksheets("Ëèñò2").Range("A" & i).Font.FontStyle = "ïîëóæèðíûé"
Worksheets("Ëèñò2").Range("A" & i).HorizontalAlignment = xlCenter
Worksheets("Ëèñò2").Range("B" & i).Font.FontStyle = "ïîëóæèðíûé"
Worksheets("Ëèñò2").Range("B" & i).HorizontalAlignment = xlCenter
End If
Worksheets("Ëèñò2").Range("A" & i).Borders.LineStyle = xlContinuous
Worksheets("Ëèñò2").Range("B" & i).Borders.LineStyle = xlContinuous
If i > 1 Then
Worksheets("Ëèñò2").Range("B" & i).NumberFormat = "0.000"
End If

в цикле?

На мой взгляд, целесообразней приложить файл пример как есть и как нужно, а не писать код в  котором сложно понять логику!
Изменено: Nordheim - 28.05.2018 11:59:44
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#11
28.05.2018 12:16:13

1.Исправил

2. 12

3. Это изменение параметров ячеек - шрифт, выравниваниеи

Код
Private Sub CommandButton2_Click()
Dim maxCENA As Single
SizeM = 12
maxCENA = CENA(1)
Worksheets("Лист2").Select
Cells(1, 1) = "Вид конфет"
Cells(1, 2) = "Стоймость за 1кг"
For i = 1 To SizeM
Cells(i + 1, 1) = KONF(i)
Cells(i + 1, 2) = CENA(i)
Next i
For i = 1 To SizeM
If i = 1 Then
Worksheets("Лист2").Range("A" & i).Font.FontStyle = "Полужирный"
Worksheets("Лист2").Range("A" & i).HorizontalAlignment = xlCenter
Worksheets("Лист2").Range("B" & i).Font.FontStyle = "Полужирный"
Worksheets("Лист2").Range("B" & i).HorizontalAlignment = xlCenter
End If
Worksheets("Ëèñò2").Range("A" & i).Borders.LineStyle = xlContinuous
Worksheets("Ëèñò2").Range("B" & i).Borders.LineStyle = xlContinuous
If i > 1 Then
Worksheets("Ëèñò2").Range("B" & i).NumberFormat = "0.000"
End If
If CENA(i) > maxCENA Then
maxCENA = CENA(i): NomerMax = i
Next i
End Sub
 
 
 
#12
28.05.2018 12:18:39
Заполняю следующим образом
Код
SizeM = 12
 For i = 1 To SizeM 
 KONF(i) = Worksheets("Лист2").Range("A" & i + 1).Value
 CENA(i) = Val(InputBox("Введите стоймость-" & KONF(i) & " в рублях", "Ввод данных"))
 Cells(i + 1, 2) = CENA(i) 
 Next i
 
 
 
#13
28.05.2018 12:35:58
xotdog8, простите, но Ваш код работать не будет, я гарантирую это.
А этот будет:
Код
Sub MaxPrice()

   Dim maxCENA As Single
   Dim i As Integer, rw As Integer
   
   maxCENA = -1
   With Worksheets(2)
      For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
         If .Cells(i, 2).Value > 0 And .Cells(i, 2).Value > maxCENA Then
            rw = i
            maxCENA = .Cells(i, 2).Value
         End If
      Next i
      If maxCENA > 0 Then .Rows(rw).Delete
   End With

End Sub
Изменено: StoTisteg - 28.05.2018 12:36:06
 
 
 
#14
28.05.2018 12:38:32
Цитата
xotdog8 написал:
Заполняю следующим образом
Зачем? почему бы не позволить юзеру вводить данные прямо на лист?
 
 
 
#15
28.05.2018 13:08:33
Необъявленный кросс
 
 
 
#16
28.05.2018 17:48:20
StoTisteg, Спасибо, понял ваш код, только ругается
 
 
 
#17
28.05.2018 19:00:16
Поняли, и не можете понять ошибку? :)
Тип данных кривой.
 
 
 
Страницы: 1
Читают тему
Наверх