Страницы: 1
RSS
VBA замена мин значения в каждом столбце на макс значение в этом же столбце без массива
 
Добрый день, помогите пожалуйста решить задачку для 9-ого класса )))) максимальные значения по столбцам вывел, процедура во вложении, минимальные значения по столбцам вывел, так же процедура во вложении, а вот как заменить без массива минимум на максимум не понимаю ........  
Изменено: Артем Кузнецов - 08.08.2020 20:02:37
 
Артем Кузнецов, а какова конечная цель? Просто все это делается с привлечением средств excel буквально в несколько строк, но надо понимать что если несколько минимумов и максимумов, то что с ними делать?
По вопросам из тем форума, личку не читаю.
 
цель понять как это работает ))) меня вполне устроил бы вариант - если у нас в столбце два раза одно и тоже число, допустим 45 (максимум) то с ним ничего не делается, а если у нас в этом же столбце два раза число 1 (минимум) то оно 2 раза и заменяется на 45 ...    
 
Код
Dim C, vMin As Double, vMax As Double
Application.FindFormat.Clear
For Each C In Selection.Columns
    vMin = WorksheetFunction.min(C)
    vMax = WorksheetFunction.max(C)
    C.Replace What:=vMin, Replacement:="QQQ", LookAt:=xlWhole, SearchFormat:=False
    C.Replace What:=vMax, Replacement:=vMin, LookAt:=xlWhole, SearchFormat:=False
    C.Replace What:="QQQ", Replacement:=vMax, LookAt:=xlWhole, SearchFormat:=False
Next
По вопросам из тем форума, личку не читаю.
 
не это не то, такое я и сам бы мог написать, чутка погуглив, в практикуме рассказывалось до этого задания только про for и for each соответственно задача должна быть реализована тоже этими же методами, без массивов, вложениями циклов, и плюс не для конкретного столбца, а для любого выделенного диапазона, как в моем файле во вложении, т.е. код должен выглядеть примерно как-то так, только не для минимального, как у меня, а для замены минимального на максимальное:
Код
Sub Мин()
      Dim k, l As Integer
      Dim n, m As Integer
      Dim i, j As Integer
      Dim max, min As Integer
      n = Selection.Row
      m = Selection.Column
      k = Selection.Rows.Count
      l = Selection.Columns.Count
      For j = m To l
      max = Cells(n, j).Value
      min = Cells(n, j).Value
      For i = n To k
      If Cells(i, j).Value <> 0 Then     'перескок через пустую ячейку т.к. по умолчанию пустая ячейка это 0
      If Cells(i, j).Value < min Then
      min = Cells(i, j).Value
      End If
      End If
      Next i
      Cells(i, j) = min
      Next j
End Sub
         
Изменено: Артем Кузнецов - 08.08.2020 20:02:06
 
ну задача и выполняется для любого выделенного диапазона, а вот то что оттачивается навык иной - я и спрашивал
Цитата
БМВ написал:
а какова конечная цель?
То как это делается в Excel  - пример выше, то как это делается на VB - это иной вопрос
По вопросам из тем форума, личку не читаю.
 
так в теме же написано VBA .... или я не туда тему поместил?
 
Артем Кузнецов, так мой код именно на нем. Вся проблема в последнем A.
По вопросам из тем форума, личку не читаю.
 
Цитата
Артем Кузнецов написал:
...такое я и сам бы мог написать, чутка погуглив, в практикуме рассказывалось до этого задания только про for и for each соответственно задача должна быть реализована тоже этими же методами...
Ну, так слегка погуглите, да и решите только этими методами
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
Цитата
Михаил Лебедев написал: Ну, так слегка погуглите, да и решите только этими методами
гениальная мысль, и конечно же она мне ну никак не могла прийти первой в голову )))) если найдете, киньте ссылочку.

Цитата
БМВ написал: так мой код именно на нем. Вся проблема в последнем A.
я может чего не понимаю? в вашем коде вообще нет никаких А ... ну я попробовал переписать ваш код в виде:   'Поменять местами минимальное значение в каждом столбце с максимальным значение в этом же столбце
Код
Sub МинНаМаксReverse()
Dim rngX As Range
Dim vMin, vMax As Double
For Each rngX In Selection.Columns
   vMin = WorksheetFunction.min(rngX)
   vMax = WorksheetFunction.max(rngX)
   rngX.Replace What:=vMin, Replacement:="QQQ", LookAt:=xlWhole, SearchFormat:=False
   rngX.Replace What:=vMax, Replacement:=vMin, LookAt:=xlWhole, SearchFormat:=False
   rngX.Replace What:="QQQ", Replacement:=vMax, LookAt:=xlWhole, SearchFormat:=False
Next
End Sub
и в таблице:
22145
1131
121314
122514
121314
и в первом столбце 1  меняется местом с 22, во втором 1 меняется с 25, и в третьем 1 меняется с 45 из-за метода Replacement,

а как заменить минимум на максимум не меняя местами?
 
Цитата
Артем Кузнецов написал:
а как заменить минимум на максимум не меняя местами?
Не ну я конечно только вернулся с игры в скрабл под портвешок, но простите, крепости его не хватает чтоб понять такую задачу.

A- Application и используется особенность приложения
По вопросам из тем форума, личку не читаю.
 
я бы тоже не отказался от портвешка )))) да я сам в шоке какие задачи приходится решать в РГППУ )))) вот есть диапазон:
22     3    45
 2   13      4
12   25    14

надо что бы 2 было равно 22 в первом столбце, 3 равно 25 во втором столбце, 4 равно 45 в третьем столбце .......

короче как то так но не совсем ... потому что с этим диапазоном работает, а вот с другим уже нет (((((((

Код
Sub МинНаМакс()
      Dim k, l As Integer
      Dim n, m As Integer
      Dim i, j As Integer
      Dim max, min As Integer
      n = Selection.Row
      m = Selection.Column
      k = Selection.Rows.Count
      l = Selection.Columns.Count
      
      For j = m To l
      max = Cells(n, j).Value
      min = Cells(n, j).Value
      For i = n To k
      
      If Cells(i, j).Value <> 0 Then      'перескок через пустую ячейку т.к. по умолчанию пустая ячейка это 0
      End If
      
      If Cells(i, j).Value > max Then
      max = Cells(i, j).Value
      End If
      
      If Cells(i, j).Value < min Then
      min = Cells(i, j).Value
      
      If Cells(i, j).Value = min Then
      Cells(i, j).Value = max
      End If
      End If
      Next i
      Cells(n, j).Value = max
      Next j
End Sub
Изменено: Артем Кузнецов - 09.08.2020 02:48:00
 
Артем Кузнецов, оформите код в своих сообщениях также, как оформлено в #4 и #5!
 
ну раз только циклами, да без массивов...
Код
Sub minmax()
    Dim r%, c%, rr%, cc%, i%, j%, mn%, mx%
    r = Selection.Row
    c = Selection.Column
    rr = Selection.Rows.Count
    cc = Selection.Columns.Count
    For i = c To c + cc - 1
        mn = Cells(r, i): mx = Cells(r, i)
        For j = r To r + rr - 1
            If Cells(j, i) > mx Then mx = Cells(j, i)
            If Cells(j, i) < mn Then mn = Cells(j, i)
        Next j
        For j = r To r + rr - 1
            If Cells(j, i) = mn Then Cells(j, i) = mx
        Next j
    Next i
End Sub

Пы.Сы. а что в практикуме сказано про тип данных в переменной k?
Код
Dim k, l As Integer
Изменено: buchlotnik - 09.08.2020 02:13:05
Соблюдение правил форума не освобождает от модераторского произвола
 
Цитата
buchlotnik написал: что в практикуме сказано про тип данных в переменной k?
ну вообще строковые переменные лучше делать Long т.к. может быть большой диапазон ...
спасибо большое ...
 
Цитата
Артем Кузнецов написал:
лучше делать Long
но у вас-то Variant
Соблюдение правил форума не освобождает от модераторского произвола
 
ну так я же знаю что для теста буду брать небольшую таблицу ... иначе там вообще фиг поймешь, что на что заменяется .....
спасибо еще раз, я бы ни за что не догнал бы как эти счетчики должны быть прописаны .......
 
Код
Sub Minimum_to_Maximum()
    Dim Minim, Maxim, Cel As Range
    With WorksheetFunction
        Minim = .Min(Selection)
        Maxim = .Max(Selection)
    End With
    For Each Cel In Selection
        If Cel.Value = Minim Then
            Cel.Value = Maxim
            Cel.Interior.Color = 65535 ' выделяем замененные ячейки
        End If
    Next
End Sub
 
а можно дурацкий вопрос? вот я переписал эту процедуру без всяких там c + cc - 1 и все работает, в практикуме тоже зачем то пишут n + k - 1, зачем это нужно?
т.е. по сути то, дело в грамотном вложении циклов, а не в счетчиках .......
и вот эта фишка с процентами вместо типа данных, это так всегда можно писать ??? т.е. можно не указывать типы ?

Код
Sub МинНаМакс()
      Dim k, p As Long
      Dim n, m As Long
      Dim i, j As Long
      Dim max, min As Double
    n = Selection.Row
    m = Selection.Column
    k = Selection.Rows.Count
    p = Selection.Columns.Count
    For j = m To p
      min = Cells(n, j)
      max = Cells(n, j)
        For i = n To k
            If Cells(i, j) <> 0 Then     'ну учитывать пустые ячейки, иначе по умолчанию пустая ячейка = 0
            End If
            If Cells(i, j) > max Then max = Cells(i, j)
            If Cells(i, j) < min Then min = Cells(i, j)
        Next i
        For i = n To k
            If Cells(i, j) = min Then Cells(i, j) = max
        Next i
    Next j
End Sub
Изменено: Артем Кузнецов - 09.08.2020 03:51:48
 
Цитата
Артем Кузнецов написал:
ну вообще строковые переменные лучше делать Long
Уже заинтригован  :D
По вопросам из тем форума, личку не читаю.
 
Доброе время суток
Цитата
Артем Кузнецов написал:
в практикуме тоже зачем то пишут n + k - 1, зачем это нужно?
Просто протестируйте свой подправленный код, выделив массив, левый верхний угол которого в I15. Сравните результат выполнения с тем, который выполняется для выделенного массива с левым верхним углом в A1. Тоже самое проделайте с предложенными вам кодами. :)
Изменено: Андрей VG - 09.08.2020 09:01:10
 
Цитата
Артем Кузнецов написал:
фишка с процентами вместо типа данных
что значит вместо? Курите матчасть
Цитата
Артем Кузнецов написал:
без всяких там c + cc - 1 и все работает,
у вас же в примере диапазон I15:K19 - там работает?
Изменено: buchlotnik - 09.08.2020 09:06:48
Соблюдение правил форума не освобождает от модераторского произвола
 
Цитата
buchlotnik написал: что значит вместо?  
у вас не прописаны ни variant ни long, а вместо них стоит %, я первый раз такую запись вижу, но я уже нашел ответ, i% означает i as integer, j& означает j as long

Цитата
Андрей VG написал: Просто протестируйте свой подправленный код, выделив массив, левый верхний угол которого в I15...
ааа понял, спасибо
 
Цитата
Артем Кузнецов написал:
это так работает?
это работает как по ссылке, что дана выше на мат часть.
Изменено: БМВ - 09.08.2020 13:16:55
По вопросам из тем форума, личку не читаю.
Страницы: 1
Наверх