Excel Macro Repetitive IF и Else

Question

В настоящее время я работаю над сценарием Mac VBA Mac, где в нем будет выполняться простой TRUE или False тест активной ячейки. Моя проблема: я не могу заставить это работать до конца списка. Он запускается только один раз и заканчивает программу. Мне нужен этот скрипт VB для выполнения теста EL & ELSE до нижней части списка.

Описание проблемы:

Скажем, у меня есть список дат в А1 A9999 и рядом с ним (F1: F9999) есть также список, который имеет текст на нем. список F1: F9999 содержит только два значения. (a) ТАКОЙ ДАТЫ и (б) НЕ ТАКОЙ.

1. Выполните проверку True или False в списке F1: F9999.

2. Если значение активной ячейки равно текст «SAME DATE» (TRUE), он будет игнорировать и перейти к следующему пункту в списке, то снова выполнить номер 1.

3. Если активное значение ячейки равный тексту «SAME DATE» (FALSE), он будет вставлять строку над ним, а затем переходить к следующему элементу в списке, а затем повторять номер 1
4. Тест TRUE или FALSE будет выполняться до конца список.
5. Тест TRUE или FALSE прекратит работу, если он достигнет нижней части списка.
6. , кстати, количество элементов в списке несовместимо. Я просто положил туда F1: F9999, например, для целей.

вот мой код!

Sub IFandElseTest() 
If ActiveCell.Value = "Same Date" Then 
Range(Selection, Cells(ActiveCell.Row, 1)).Select 
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
ActiveCell.Offset(1, 0).Select 
Else: 
ActiveCell.Offset(1, 0).Select 
Range(Selection, Cells(ActiveCell.Row, 1)).Select 
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
End If 


End Sub 

Appreaciate, если вы могли бы помочь мне в этом.

Answer 1

Дайте это попробовать.

Объяснение:

1. Вы должны избегать использования .Select/ActiveCell и т.д. Вы можете увидеть это LINK
2. При работе с последней строкой, то лучше не жесткие кодовыми значениями, но динамически найти последнюю ряд. Возможно, вы захотите увидеть это LINK
3. Работа с объектами, если текущий лист не является листом, с которым вы хотите работать?
4. Ниже цикла FOR будет пересекать ряд снизу и двигаться вверх.

Код:

Sub Sample() 
    Dim ws As Worksheet 
    Dim LRow As Long, i As Long 
    Dim insertRange As Range 

    '~~> Chnage this to the relevant sheet 
    Set ws = ThisWorkbook.Sheets("Sheet1") 

    '~~> Work with the relevant sheet 
    With ws 
     '~~> Get the last row of the desired column 
     LRow = .Range("E" & .Rows.Count).End(xlUp).Row 

     '~~> Loop from last row up 
     For i = LRow To 1 Step -1 
      '~~> Check for the condition 
      '~~> UCASE changes to Upper case 
      '~~> TRIM removes unwanted space from before and after 
      If UCase(Trim(.Range("E" & i).Value)) = "SAME DATE" Then 
       '~~> Insert the rows 
       .Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
      End If 
     Next i 
    End With 
End Sub 

Скриншот:

Followup От Комментарии

Это действительно сработало! НО, одна окончательная модификация. в вашем коде: Установите ws = ThisWorkbook.Sheets («Sheet1») Возможно ли, что вы можете установить WS как активный лист. Причина этого заключается в том, что имя рабочего листа является уникальным и несовместимым.

Как я уже упоминал, в первой ссылке выше, а также в комментарии, не используйте Activesheet. Используйте CodeNames листа, который не изменяется. См. Снимок экрана ниже.

Blah Blah это имя листа, который вы видите на вкладке рабочего листа, но Sheet1 является CodeName, которая не изменится. то есть вы можете изменить имя листа от Blah Blah сказать Kareen но в редакторе VBA, вы заметите, что Codename не меняет :)

Изменить код

Set ws = ThisWorkbook.Sheets("Sheet1") 

в

'~~> Replace Sheet1 with the relevant Code Name 
Set ws = [Sheet1] 

Answer 2

Edit:

Если оставить вне r.copy линии она более или менее точно, что делает решение Сиддхарта разгромить в

Sub insrow() 
    Dim v, r As Range 
    Set r = [d1:e1] 
    v = r.Columns(1).Value 
    Do 
    ' r.copy 
    If v = "Same Date" Then r.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    Set r = r.Offset(1) 
    v = r.Columns(1).Value 
    Loop Until v = "" 
End Sub 

Это еще не включать граничное условие, если строка превышает линию 9999 но это должно быть легко добавить ...