Question

这是一个非常简单的问题，我不知道问题出在哪里。

我希望VBA遍历工作表中的所有行，如果X行，Y列中的单元格包含的值不同于“ All OK”（或者其他方式-如果特定单元格包含“需要采取行动”）。它必须有一个循环（循环没有问题）。

一个重要的信息是“所有OK”或“需要采取的措施”不是这样的值-由公式“ = IF（OR（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

如果单元格包含

1 个答案: