Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Цикл в VBA и выгрузка значений цикла в ячейки и ListBox, от 1,6 до 1,76 с шагом 0,001
 
#1
29.11.2013 07:00:04
Добрый День уважаемые форумчане!
Пытаюсь изучать VBA в экселе и применять его к своим задачам.
Суть вопроса состоит в следующем: Написал макрос цикла для значений от 1,6 до 1,76 с шагом 0,001 и написал формулу которая зависит от этих значений.
Вот сам код:

Код
Sub Коэффициент_трансформации()
    Dim b As Single
    Dim Ew As Single
        For b = 1.6 To 1.76 Step 0.001
        Ew = 2 * Pi * 2000 * b * 50 * 0.0001 / (2 ^ (1 / 2))
        Next b  
Cells(1, 1) = b
Cells(1, 2) = Ew
End Sub

Нужно выгрузить сначала все значения b и все значения Ew, соответствующие значениям b в ячейки и так же в листбокс, а потом еще выгрузить строки например так же b и Ew только только когда Ew меньше 75.
Данную задачу я сделал с помощью формул в ячейках и потом с помощью условного форматирования окрасил те строки для которых выполняется условие Ew<75.
Помогите пожалуйста с данной задачкой.
Файл прилагаю.
 
 
 
#2
29.11.2013 09:05:10
Для выгрузки в ячейки попробуйте так:


Код
Sub Коэффициент_трансформации()
'перебор индукций от 1,6 до 1,76 с шагом 0,001
    Dim b As Single
    Dim Ew As Single
        i = 1
        For b = 1.6 To 1.76 Step 0.001
        'Вольт на виток
        Ew = 2 * Pi * 2000 * b * 50 * 0.0001 / (2 ^ (1 / 2))
        Cells(i, 1) = b
        Cells(i, 2) = Ew
        i = i + 1
        Next b
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
29.11.2013 09:41:16
Код
Ew = 2 * WorksheetFunction.Pi * 2000 * b * 50 * 0.0001 / Sqr(2)
Согласие есть продукт при полном непротивлении сторон
 
 
 
#4
29.11.2013 09:46:48
грузим листбокс
Код
Const Pi As Single = 3.14
Sub Коэффициент_трансформации()
    Dim b As Single
    Dim Ew As Single
    Sheets("Лист1").ListBox1.Clear
    For b = 1.6 To 1.76 Step 0.001
        Ew = 2 * Pi * 2000 * b * 50 * 0.0001 / Sqr(2)
        If Ew < 75 Then
            With Sheets("Лист1").ListBox1
                 .AddItem 
        i = .ListCount - 1
                .List(i, 0) = b
                .List(i, 1) = Ew
            End With
        End If
    Next b
End Sub
Изменено: kalbasiatka - 29.11.2013 10:19:18
 
 
 
#5
29.11.2013 11:09:04
Спасибо Вам большое, разобрался с Вашей помощью, оказывает все просто, присваиваешь i вначале, потом после записи в ячейку к i прибавляется 1. Только что то не получилось с загрузкой в листбокс, загрузился только первый столбик, в чем дело не могу понять.
 
 
 
#6
29.11.2013 11:13:44
Пардон, надо было в свойствах указать два столбца (Column Count =2)
 
 
 
#7
03.12.2013 08:40:26
У меня по данной задачке еще вот один вопрос возник:
Имеется макрос, который вы мне помогли написать:

Код
Const Pi As Single = 3.14
Sub Коэффициент_трансформации()
    Dim b As Single
    Dim Ew As Single
    Sheets("Лист1".ListBox1.Clear
    For b = 1.6 To 1.76 Step 0.001
        Ew = 2 * Pi * 2000 * b * 50 * 0.0001 / Sqr(2)
        If Ew < 75 Then
            With Sheets("Лист1".ListBox1
                 .AddItem 
        i = .ListCount - 1
                .List(i, 0) = b
                .List(i, 1) = Ew
            End With
        End If
    Next b
End Sub

Но возникла небольшая проблема. Например для параметра Ew у меня может быть два случая:
1. Если Range("A1" ) = 1, то Ew = 2 * Pi * 2000 * b * 50 * 0.0001 / Sqr(1)
2. Если Range("A1" )  = 2, то Ew = 2 * Pi * 2000 * b * 50 * 0.0001 / Sqr(2)

Если написать данное условие внутри цикла:
Код
Const Pi As Single = 3.14
Sub Коэффициент_трансформации()
    Dim b As Single
    Dim Ew As Single
    Sheets("Лист1".ListBox1.Clear
    For b = 1.6 To 1.76 Step 0.001
   If Range("A1" = 1 Then
        Ew = 2 * Pi * 2000 * b * 50 * 0.0001 / Sqr(1)
   If Range("A1" = 2 Then
        Ew = 2 * Pi * 2000 * b * 50 * 0.0001 / Sqr(2)
   End If
        If Ew < 75 Then
            With Sheets("Лист1".ListBox1
                 .AddItem 
        i = .ListCount - 1
                .List(i, 0) = b
                .List(i, 1) = Ew
            End With
        End If
    Next b
End Sub

то будет происходить ошибка, не знаю как написать данное условие внутри макроса. Помогите пожалуйста, кто знает решение данной проблемы.
Изменено: AlexZanderG - 03.12.2013 09:41:05
 
 
 
#8
03.12.2013 10:20:40
Без If:

Код
 Ew = 2 * Pi * 2000 * b * 50 * 0.0001 / Sqr(cells(1,1).value)
 
 
 
#9
03.12.2013 12:28:46
Оказалось все гораздо проще:


Код
Const Pi As Single = 3.14
Sub Коэффициент_трансформации()
    Dim b As Single
    Dim Ew As Single
    Sheets("Лист1".ListBox1.Clear
    For b = 1.6 To 1.76 Step 0.001
   If Range("A1" = 1 Then
        Ew = 2 * Pi * 2000 * b * 50 * 0.0001 / Sqr(1)
   End If
   If Range("A1" = 2 Then
        Ew = 2 * Pi * 2000 * b * 50 * 0.0001 / Sqr(2)
   End If
        If Ew < 75 Then
            With Sheets("Лист1".ListBox1
                 .AddItem 
        i = .ListCount - 1
                .List(i, 0) = b
                .List(i, 1) = Ew
            End With
        End If
    Next b
End Sub
 
 
 
Страницы: 1
Читают тему
Наверх