Страницы: 1
RSS
VBA сделать массив из значений имеющихся на листе, макрос, сделать массив из значений имеющихся на листе
 
Доброго времени суток, подскажите пожалуйста, вот есть задача - Дан список дневных и ночных температур за неделю. Определить день, с максимальной разницей дневных и ночных температур, решить через массивы, алгоритм то понятен, из наибольших температур, пускай это будут дневные, вычитаем наименьшие, пускай будут ночные, можно даже занести эту разницу в дополнительный столбец, и в этом столбце ищем наибольшее значение, но как занести эти значения из столбцов в массивы? то что у меня получилось во вложении, но это не правильно т.к. через locals window видно что заносятся одни нули, и только последнее значение заносится верно ... где ошибка, не пойму ....      

Код
Sub температура()    Dim DNedX() As String
    Dim DenX() As Integer, NochX() As Integer, RaznX() As Integer
    Dim n, i As Integer
    Dim max, min As Integer
        
        'пересчет строк в каждом массиве (столбце)
        n = Cells(Rows.Count, 1).End(xlUp).Row
        For i = 1 To n
        ReDim DNedX(n)
        ReDim DenX(n)
        ReDim NochX(n)
        ReDim RaznX(n)
        Next
        
        'присваивание массивам значений и расчет разницы с занесением в новый массив
        For i = 1 To n
        DNedX(n) = Cells(i, 1).Value
        DenX(n) = Cells(i, 2).Value
        NochX(n) = Cells(i, 3).Value
        RaznX(n) = Cells(i, 4).Value
        
        RaznX(n) = DenX(n) - NochX(n)
        Cells(i, 4) = RaznX(n)
        Next

        'поиск максимального
        ReDim Preserve RaznX(n)
        max = i
        For i = 1 To n
        If RaznX(i) > max Then max = RaznX(i)
        Next
        
        'вывод результата
        For i = 1 To n
        Cells(1, 6).Value = "Максимальная разница в: " & DNedX(i)
        Cells(1, 7).Value = "Равна: " & RaznX(i)
        Cells(1, 6).Columns.AutoFit
        Cells(1, 7).Columns.AutoFit
        Next
End Sub
Изменено: Артем Кузнецов - 14.08.2020 01:27:08
 
Цитата
Артем Кузнецов написал:
VBA сделать массив из значений имеющихся на листе
вот этот макрос:
Код
Sub GetData()
  Dim a
  a = [a1].CurrentRegion
End Sub
примет значения с листа в массив а (собственно,  вы спрашивали как значения с листа получить в массив)

а вот этот макрос:
Код
Sub MaxDiff()
  Dim a, r&, d&, m#
  a = [a1].CurrentRegion
  For r = 1 To UBound(a)
    If a(r, 2) - a(r, 3) > m Then m = a(r, 2) - a(r, 3): d = r
  Next
  MsgBox "максимальная разница =  " & m & vbLf & "день - " & a(d, 1)
End Sub
определит максимальную разницу температур и укажет день, когда это случилось
Изменено: Ігор Гончаренко - 15.08.2020 11:55:28
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
как-то всё у вас сложно...
Код
Sub температура2()
    Dim n&, i&, d$, rd$, r%, rm%, rc%, arr
    n = Cells(Rows.Count, 1).End(xlUp).Row
    arr = Range(Cells(1, 1), Cells(n, 3))
    For i = 1 To n
        rc = arr(i, 2) - arr(i, 3)
        If rc > rm Then rm = rc: rd = arr(i, 1)
    Next
    Cells(1, 6).Value = "Максимальная разница в: " & rd
    Cells(1, 7).Value = "Равна: " & rm
End Sub
Изменено: buchlotnik - 14.08.2020 02:07:07
Соблюдение правил форума не освобождает от модераторского произвола
 
всем спасибо, что тут сказать, первый код соответствует подписи )))))))) Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете! )))
Изменено: Артем Кузнецов - 14.08.2020 02:28:14
 
кто нибудь, подскажите пожалуйста, в коде от buchlotnik запись  If rc > rm Then rm = rc : rd = arr(i, 1) как еще можно было бы записать это без :   ? просто в справке написано что : используется просто для записи  нескольких операторов в одной строчке т.е. по идеи можно просто  перенести часть rd = arr(i, 1) на другую строчку, удалить : и все будет  тоже самое, но на самом деле, тогда макрос работает по другому, тоже самое кстати  и в коде Ігоря Гончаренкоm = a(r, 2) - a(r, 3): d = r  ....
Изменено: Артем Кузнецов - 15.08.2020 03:00:42
 
Артем Кузнецов,  посмотрите справку по IF ... Then ... Else ... Endif и все встанет на свои места.
Изменено: БМВ - 15.08.2020 08:01:43
По вопросам из тем форума, личку не читаю.
 
Цитата
Артем Кузнецов написал:
по идеи можно просто  перенести
мдя? странную справку вы читаете...
If rc > rm Then
       rm = rc
       rd = arr(i, 1)
End if
Соблюдение правил форума не освобождает от модераторского произвола
 
Цитата
buchlotnik написал:
странную справку вы читаете
Тезка, не странную а просто другую. Про : все правильно прочтено, но не учел ТС что там IF
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
Про : все правильно прочтено
да да именно про : справку я и читал, спасибо
Страницы: 1
Наверх