если ячейка содержит то

Question

Это очень простой вопрос, и я не знаю, в чем проблема.

Я хочу, чтобы VBA прошел через все строки на листе и выполнил действие для строки X, если ячейка в строке X, столбец Y содержит значение, отличное от «Все в порядке» (или другим способом - если содержит определенную ячейку). Требуется действие "). Это должно быть с циклом (без проблем с циклом).

Одна важная информация состоит в том, что «Все в порядке» или «Необходимое действие» не являются значениями как таковыми - они запускаются по формуле «= IF (ИЛИ (B2 <>» «, C2 <>» «, D2 <>» ")," Требуется действие "," Все в порядке ")".

Также кое-что, что я заметил, это то, что когда я медленно запускаю макрос с точкой останова переключения, он работает правильно. Однако, если я запускаю это с кнопкой запуска без каких-либо точек разрыва, он выбрасывает все строки (независимо от того, «Все ли в порядке» или «Требуется действие»). Есть идеи почему?

Sub SplitToWorksheets()
Dim ColHead As String
Dim ColHeadCell As Range
Dim iCol As Integer
Dim iRow As Long 'row index on Fan Data sheet
Dim Lrow As Integer 'row index on individual destination sheet
Dim Dsheet As Worksheet 'destination worksheet
Dim fsheet As Worksheet 'fan data worksheet (assumed active)
Dim status As String
Dim ws As Worksheet

OptimizeVBA True

Set fsheet = Worksheets("CM | Impact")

iCol = 1
status = "Action Needed"

i = fsheet.Range("A1").CurrentRegion.Rows.Count

For iRow = 2 To i

If fsheet.Cells(iRow, 5) = status Then

If Not SheetExists(CStr(fsheet.Cells(iRow, iCol).Value)) Then
Set Dsheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Dsheet.Name = CStr(fsheet.Cells(iRow, iCol).Value)
fsheet.Rows(1).Copy Destination:=Dsheet.Rows(1)

Else
Set Dsheet = Worksheets(CStr(fsheet.Cells(iRow, iCol).Value))
End If

Lrow = Dsheet.Cells(10000, iCol).End(xlUp).Row
fsheet.Rows(iRow).Copy Destination:=Dsheet.Rows(Lrow + 1)

Else 
End If

Next iRow

Большое спасибо за помощь!

РЕДАКТИРОВАТЬ: Это хорошо работает, когда я вставил формулы (тот, который вызывает «Все ОК» или «Требуется действие» в качестве значений, но я хочу сохранить формулы при выполнении кода ...

Answer 1

Я добрался до семьи, но между несколькими домашними делами и этим я написал вам отличный код.

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

 .Calculate

Тем не менее, циклический просмотр рабочих листов в большинстве случаев является плохой практикой. Учитесь делать вещи в массивах. По некоторым причинам это включает в себя пустую строку, но у меня нет времени, чтобы понять это, однако это то, что я предлагаю вам изучить, понять и посвятить себя памяти.

Private Sub MarekResCodeChange()
    Dim pickUp As Variant, vArr As Variant
    Dim ws As Worksheet
    Dim i As Long, j As Long, z As Long, y As Long
    Dim dropOff() As String, sheetname As String
    y = ThisWorkbook.Worksheets("CM | Impact").UsedRange.Columns.Count
    j = 1
    ReDim dropOff(1 To y, 1)
    pickUp = ThisWorkbook.Worksheets("CM | Impact").UsedRange
    For i = LBound(pickUp, 1) To UBound(pickUp, 1)
        If pickUp(i, 5) = "Action Needed" Then
            For z = 1 To y
                Debug.Print ; pickUp(i, z)
                dropOff(z, j) = pickUp(i, z)
            Next z
            j = j + 1
            ReDim Preserve dropOff(1 To y, j)
        End If
    Next i
    vArr = Split(Cells(1, y).Address(True, False), "$")
    Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    Sheets(ThisWorkbook.Sheets.Count).Range("a1:" & vArr(0) & j).Value = Application.Transpose(dropOff)
End Sub