Неправильно работает IF в VBA и удаление строк в диапазоне

@NauanS · Регистрация: 23.11.2020

Author24 — интернет-сервис помощи студентам

Доброе время суток, уважаемые форумчане и коллеги!

Написал код для калькулятора расчета рейтингов. Однако, я был бы не я, если бы мой код работал as intended.

В данном случае, следующие проблемы:

1. Не работающий IF (если):

• «K1» повторяется дважды: в ячейках «С25» и «С48», притом значение в «С25» неправильное. Должно возвращаться только значение в ячейке «С48»
• Доля Ф/Л повторяется дважды: в ячейках «С33» и «С46», притом значение в «С33» неправильное. Должно возвращаться только значение в ячейке «С46»
• Значение «Покрытие ОКУ» в ячейке «С30» неправильное

Вот часть кода, которая, по-моему содержит ошибки:

Visual Basic

'Повышающие факторы
 
 
If K1Result = 2 Or K1Result = 1.5 Then
Range("C25").Value = VR(K1TextBox.Text)
End If
 
If K4Result = 2 Or K4Result = 1.5 Then
Range("C26").Value = VR(K4TextBox.Text)
End If
 
If ProsrochkaResult = 2 Or ProsrochkaResult = 1.5 Then
Range("C27").Value = VR(ProsrochkaTextBox)
End If
 
If APLResult = 1.5 Then
Range("C27").Value = Val(x)
End If
 
If ProsrochkaResult = 2 Or ProsrochkaResult = 1.5 Then
Range("C28").Value = VR(ProsrochkaTextBox)
End If
 
If NPLResult = 2 Or NPLResult = 1.5 Then
Range("C29").Value = VR(NPLTextBox.Text)
End If
 
If OKUResult = 2 Or OKUResult = 1.5 Then
Range("C30").Value = OKUTextBox
End If
 
If RostAktivovResult = 2 Or RostAktivovResult = 1.5 Then
Range("C31").Value = RostAktivovTextBox
End If
 
If RostSpResult = 1.5 Then
Range("C32").Value = RostspTextBox
End If
 
If FLResult = 1.5 Then
CellFL = FLperTextBox
Range("C33").Value = CellFL
End If
 
If SIFIResult = 0.5 Or SIFIResult = 1 Then
Range("C34").Value = RazmerBox1
End If
 
If DefaultTextBox = 0 Then
Range("C35").Value = "Не было дефолта"
End If
 
If AdjPcTextBox = 0.15 Then
Range("C36").Value = "Высокий рейтинг родительской организации"
End If
 
If AdjPcTextBox = 0.1 Then
Range("C36").Value = "Средний рейтинг родительской организации"
End If
 
If AdjPcTextBox = 0.05 Then
Range("C36").Value = "Низкий рейтинг родительской организации"
End If
 
 
'Нейтральные факторы
 
If K1Result = 1 Then
Range("C38").Value = VR(K1TextBox.Text)
End If
 
If K4Result = 1 Then
Range("C39").Value = VR(K4TextBox.Text)
End If
 
If APLResult = 1 Then
Range("C40").Value = VR(x)
End If
 
If ProsrochkaResult = 1 Then
Range("C41").Value = VR(ProsrochkaTextBox)
End If
 
If NPLResult = 1 Then
Range("C42").Value = VR(NPLTextBox.Text)
End If
 
If OKUResult = 1 Then
Range("C43").Value = OKUTextBox
End If
 
If RostAktivovResult = 1 Then
Range("C44").Value = RostAktivovTextBox
End If
 
If RostSpResult = 1 Then
Range("C45").Value = RostspTextBox
End If
 
If FLResult = 1 Then
CellFL = FLperTextBox
Range("C46").Value = CellFL
End If
'Понижающие
 
If K1Result = 0.5 And K1Result = 0 Then
Range("C48").Value = VR(K1TextBox.Text)
End If
 
If K4Result = 0.5 And K4Result = 0 Then
Range("C49").Value = VR(K4TextBox.Text)
End If
 
If APLResult = 0.5 And APLResult = 0 Then
Range("C50").Value = VR(x)
End If
 
If ProsrochkaResult = 0.5 And ProsrochkaResult = 0 Then
Range("C51").Value = VR(ProsrochkaTextBox)
End If
 
If NPLResult = 0.5 And NPLResult = 0 Then
Range("C52").Value = VR(NPLTextBox.Text)
End If
 
If OKUResult = 0.5 And OKUResult = 0 Then
Range("C53").Value = OKUTextBox
End If
 
If RostAktivovResult = 0.5 And RostAktivovResult = 0 Then
Range("C54").Value = RostAktivovTextBox
End If
 
If RostSpResult = 0.5 And RostSpResult = 0 Then
Range("C55").Value = RostspTextBox
End If
 
If FLResult = 0.5 And FLResult = 0 Then
CellFL = FLperTextBox
Range("C56").Value = CellFL
End If
 
If SIFIResult = 0 Then
Range("C57").Value = RazmerBox1
End If
 
If DefaultTextBox = -0.025 Then
Range("C58").Value = "Нефинансовая помощь государства"
End If
 
If DefaultTextBox = -0.05 Then
Range("C58").Value = "Дефолт"
End If
 
If AdjPcTextBox = 0 Then
Range("C59").Value = "Нет Родительской Организации"
End If

Заранее извиняюсь за проблемы с кириллицей (хотя Excel файле на нескольких компьютерах открывается без кваказябр)

Во всех случаях неправильного значения, возвращается почти что всегда 1.

Перепробовал разные тестовые данные, но проблема остается.

2. Удаление строк:

Ну и последняя проблема – я взял с интернета код для удаления строк в заданном диапазоне (range) если определенные ячейке пустые. Пробовал менять диапазон – не выходит.

Вот код

Python

Sub sbVBS_To_Delete_Blank_Rows_In_Range()
 
 
Dim iCntr
Dim rng As Range
Set rng = Range("Ñ25:C60")
 
    For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
        If Application.WorksheetFunction.CountA(Rows(iCntr)) = 0 Then Rows(iCntr).EntireRow.Delete
    Next

В Архиве – сам файл и тестовые данные к нему

@Narimanych · 06.12.2020, 13:50

NauanS,
Архив не прикреплен

Добавлено через 1 минуту
NauanS,
Кто писал вам код?

Добавлено через 1 минуту
Если вы сами- то вопросов, которые вы выставили ( кроме последнего) не возникло бы.

Добавлено через 1 минуту
Посмотрите ваше условие строка 106 и внимательно подумайте, что здесь не так..

Сообщение от NauanS

If K1Result = 0.5 And K1Result = 0 Then
Range("C48").Value = VR(K1TextBox.Text)
End If
If K4Result = 0.5 And K4Result = 0 Then
Range("C49").Value = VR(K4TextBox.Text)
End If
If APLResult = 0.5 And APLResult = 0 Then
Range("C50").Value = VR(x)
End If

Добавлено через 1 минуту
Как может быть истиной выражение ?
X=0.5 И X=0

@NauanS · 06.12.2020, 13:53 **[ТС]**

Narimanych, код писался коллективно

Вижу ошибку в коде). Спасибо!

Прикладываю архив к сообщению

@Narimanych · 06.12.2020, 13:58

NauanS,

Сообщение от NauanS

сли определенные ячейке пустые.

Какие?

@NauanS · 06.12.2020, 14:02 **[ТС]**

Python

С25:С60

@Narimanych · 06.12.2020, 14:17

NauanS,

Сообщение от NauanS

код для удаления строк в заданном диапазоне (range)

Сообщение от NauanS

С25:С60

Visual Basic

Sub MMM()
Application.ScreenUpdating = False
    With ThisWorkbook.Sheets("Калькулятор")
       For i = 60 To 25 Step -1
            If IsEmpty(Cells(i, 3)) Then
             If Not Cells(i, 3).MergeCells Then Rows(i).Delete
            End If
       Next
    End With
 Application.ScreenUpdating = True
End Sub

@NauanS · 06.12.2020, 14:37 **[ТС]**

Я обновил файл согласно вашим рекомендациям, теперь нет проблем со значениями, но строчки не удаляются. Приложил обновленный файл

@Hugo121 · 06.12.2020, 15:56

Сообщение от NauanS

но строчки не удаляются.

- расскажите как Вы этот код вызываете, я не нашёл.
Но в любом случае строки удаляются, если его поместить в стандартный модуль.
Только строка

Visual Basic

1	With ThisWorkbook.Sheets("Калькулятор")

смысла не имеет, т.к. в коде не используется.

@NauanS · 06.12.2020, 16:17 **[ТС]**

Сообщение от Hugo121

- расскажите как Вы этот код вызываете, я не нашёл.
Но в любом случае строки удаляются, если его поместить в стандартный модуль.
Только строка

Я думал это в том же userform оставить

Мне просто нужно чтобы ТОЛЬКО после расчета всех показателей, удалялись пустые строчки

Добавлено через 45 секунд

Сообщение от NauanS

Мне просто нужно чтобы ТОЛЬКО после расчета всех показателей, удалялись пустые строчки

Как это как раз сделать?

Куда нужно вставлять код?

@Hugo121 · 06.12.2020, 17:35

Ну можно и там оставить, только вызов макроса сделайте, и укажите на каком листе будете применять. Правильно укажите!

Добавлено через 5 минут
Проверил, работает - всего лишь добавил вызов на форме и точки в код.

Visual Basic

1
2
3

            If IsEmpty(.Cells(i, 3)) Then
                If Not .Cells(i, 3).MergeCells Then .Rows(i).Delete
            End If

@Catstail · 06.12.2020, 17:47

Не по теме:

Сообщение от NauanS

Не работающий IF

- срочно сообщите в Microsoft! В VBA ошибка!

@Narimanych · 06.12.2020, 18:27

NauanS,

Сообщение от NauanS

Куда нужно вставлять код?

Посмотрите файл:

@NauanS · 07.12.2020, 08:21 **[ТС]**

Спасибо!
Сработало!

@Narimanych · 07.12.2020, 09:33

NauanS,

Сообщение от NauanS

Спасибо!
Сработало!

Велкоме

Неправильно работает IF в VBA и удаление строк в диапазоне

Решение

Решение

@Narimanych 2724 / 1701 / 776 Регистрация: 23.03.2015 Сообщений: 5,388
	06.12.2020, 13:50	2
	NauanS, Архив не прикреплен Добавлено через 1 минуту NauanS, Кто писал вам код? Добавлено через 1 минуту Если вы сами- то вопросов, которые вы выставили ( кроме последнего) не возникло бы. Добавлено через 1 минуту Посмотрите ваше условие строка 106 и внимательно подумайте, что здесь не так.. Сообщение от NauanS If K1Result = 0.5 And K1Result = 0 Then Range("C48").Value = VR(K1TextBox.Text) End If If K4Result = 0.5 And K4Result = 0 Then Range("C49").Value = VR(K4TextBox.Text) End If If APLResult = 0.5 And APLResult = 0 Then Range("C50").Value = VR(x) End If Добавлено через 1 минуту Как может быть истиной выражение ? X=0.5 И X=0 1

@Narimanych 2724 / 1701 / 776 Регистрация: 23.03.2015 Сообщений: 5,388
	06.12.2020, 13:58	4
	NauanS, Сообщение от NauanS сли определенные ячейке пустые. Какие? 0

@NauanS 0 / 0 / 0 Регистрация: 23.11.2020 Сообщений: 27
	06.12.2020, 16:17 [ТС]	9
	Сообщение от Hugo121 - расскажите как Вы этот код вызываете, я не нашёл. Но в любом случае строки удаляются, если его поместить в стандартный модуль. Только строка Я думал это в том же userform оставить Мне просто нужно чтобы ТОЛЬКО после расчета всех показателей, удалялись пустые строчки Добавлено через 45 секунд Сообщение от NauanS Мне просто нужно чтобы ТОЛЬКО после расчета всех показателей, удалялись пустые строчки Как это как раз сделать? Куда нужно вставлять код? 0

@Catstail
	06.12.2020, 17:47 #11
	Не по теме: Сообщение от NauanS Не работающий IF - срочно сообщите в Microsoft! В VBA ошибка! 0

@NauanS 0 / 0 / 0 Регистрация: 23.11.2020 Сообщений: 27
	07.12.2020, 08:21 [ТС]	13
	Спасибо! Сработало! 0

@Narimanych 2724 / 1701 / 776 Регистрация: 23.03.2015 Сообщений: 5,388
	07.12.2020, 09:33	14
	NauanS, Сообщение от NauanS Спасибо! Сработало! Велкоме 0