Question

我有一个电子表格，其中的列填充了字符串。有时会有一个字符串的几个实例（我已将它排序，因此它们全部组合在一起）所以我创建了一个宏来查看列中的当前行，确定它是否已在第二个工作表中发布，如果有，它会移动到下一行，如果它没有发布它然后继续前进。

它完美地工作直到它完全忽略最后一个条目。最后一个条目是其中一个有几个相同字符串的实例，所以问题几乎肯定不是它只是忽略了最后一行。

无论重复多少次，它都会完全忽略最后一个条目。 vba新手所以任何帮助表示赞赏。

Sub RCFS()
    Dim ProfCtr As String
    Dim S2FreecellH As Long
    Dim ProfCenCellH As Long

    S2FreecellH = 3
    ProfCenCellH = 2
    ProfCtr = Cells(ProfCenCellH, 4)
    Worksheets("Sheet2").Cells(S2FreecellH, 1).Value = ProfCtr

    While IsEmpty(Cells(ProfCenCellH, 4).Value) = False
        If Cells(ProfCenCellH, 4).Value <> ProfCtr Then
            Worksheets("Sheet2").Cells(S2FreecellH, 1) = ProfCtr
            S2FreecellH = S2FreecellH + 1
            ProfCtr = Cells(ProfCenCellH, 4)
            ProfCenCellH = ProfCenCellH + 1
        Else
            ProfCenCellH = ProfCenCellH + 1
        End If
    Wend
End Sub

Answer 1

实际上，即使到达空单元格，您的循环仍需要清空ProfCtr的值。您可以通过提前If条件中的一行（添加+ 1）来使其工作。

还包括其他一些改进：

Do While Not IsEmpty(Cells(ProfCenCellH, 4).Value)
    If Cells(ProfCenCellH + 1, 4).Value <> ProfCtr Then
        Worksheets("Sheet2").Cells(S2FreecellH, 1) = ProfCtr
        S2FreecellH = S2FreecellH + 1
        ProfCtr = Cells(ProfCenCellH, 4)
    End If
    ProfCenCellH = ProfCenCellH + 1
Loop

Answer 2

让我看看我是否有这个权利

    ' Stop when you reach an empty cell
    While IsEmpty(Cells(ProfCenCellH, 4).Value) = False

    ' If the cell's value matches the variable ProfCtr then
    ' ignore it and move to the next row.
    If Cells(ProfCenCellH, 4).Value <> ProfCtr Then

       ' But if it -doesn't- match, then copy the variable
       ' ProfCtr to Sheet 2.
        Worksheets("Sheet2").Cells(S2FreecellH, 1) = ProfCtr

       ' Increment your rows
        S2FreecellH = S2FreecellH + 1

       ' Set the next bit of text to copy
        ProfCtr = Cells(ProfCenCellH, 4)
        ProfCenCellH = ProfCenCellH + 1
    Else
        ProfCenCellH = ProfCenCellH + 1
    End If

在复制到Sheet2之前，你不应该设置Prof Ctr = Cells(ProfCenCelH, 4)吗？

Answer 3

trincot有正确的答案。这是一种使用内置方法的替代技术，它将完成相同的任务。

With Worksheets("Sheet1")
    .Range("D1", .Range("D" & .Rows.Count)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet2.Range("A1"), Unique:=True
End With

循环结束时的逻辑问题

3 个答案: