0

所以昨天我发布了我的第一个 SO 问题，它像一吨砖一样倒下。但是我已经振作起来，掸掉自己的灰尘，希望这个问题会更容易被接受...... :-)

我正在尝试从我必须监控的健康问卷列表中删除数据重复项，但我一直在努力解决的棘手问题是在一列中找到重复项，然后检查同一行上的数据是否为 ​​3 个相邻列也是重复的。存储搜索到的“重复行”是让我失望的一点。

这是我从其他功能相似的脚本中拼凑而成的一些代码。我现在处于调试模式并不断抛出错误......我没有太多的 VBA 经验，所以我用完了选项。

我目前收到变量的类型不匹配错误g，还有firstAddress. 为什么这些会引起问题？？？

我可以打电话firstAddress.Row还是我在叫错树？

这是片段：

g = .Find(Range("G" & i).Text, LookIn:=xlValues)
            If Not g Is Nothing Then
                firstAddress = g.Address
                dupRow = firstAddress.Row

这是下面的整个代码。任何帮助将非常感激！

Sub FindCpy()
Dim lw As Long
Dim i As Integer
Dim sh As Worksheet
Dim dupRow As Integer
Dim g As Integer
Dim firstAddress As Integer


'Used for the new worksheet we are pasting into
Dim objNewSheet As Worksheet
Dim rngNextAvailbleRow As Range

'Used to narrow down the logical operators for duplicates
Dim rngFirst As Range

'Set the ranges
rngFirst = Range("G" & 1, "G" & lw)

Set sh = Sheets("Completed")
lw = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To lw 'Find duplicates from the list.
    If Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) = "Complete" Then

    'if COMPLETE, check the rest of the sheet for any 'in progress' duplicates...
    With Worksheets("Still In Progress").rngFirst
        g = .Find(Range("G" & i).Text, LookIn:=xlValues)
        If Not g Is Nothing Then
            firstAddress = g.Address
            dupRow = firstAddress.Row
            If Range("H" & dupRow).Text = Range("H" & i).Text _
            And Range("I" & dupRow).Text = Range("I" & i).Text _
            And Range("J" & dupRow).Text = Range("J" & i).Text Then

        'select the entire row
        Range.EntireRow.Select

        'copy the selection
        Selection.Cut

        'Now identify and select the new sheet to paste into
        Set objNewSheet = ThisWorkbook.Worksheets("Completed")
        objNewSheet.Select

        'Looking at your initial question, I believe you are trying to find the next     available row
        Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)

        Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
        ActiveSheet.Paste

        'delete the initial row
        rngCell.EntireRow.Delete

        Set g = .FindNext(g)
            Loop While Not g Is Nothing And g.Address <> firstAddress
        End If
    End With
Next i
End Sub
4

1 回答 1

0

我仔细检查了你的代码。有很多问题。其中一些我认为我能够修复 - 有一个我猜到了你打算做什么，但其中一个我只是标记了它；你需要解释你试图做什么，因为你正在删除一个你从未定义过的范围......

第一个问题是行：

If Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) = "Complete" Then

该CountIf函数返回一个数字；您正在将此数字与字符串“完成”进行比较。我认为您永远无法越过这一行，因此其余代码（无论是否正确）都不会执行。不完全清楚您在这一行中尝试做什么，因为我不确定一行何时会被标记为“完成” - 但假设您有兴趣执行其余代码，如果单元格中A & i有字符串“完成”，那么你可能想做

If Range("A" & i).Text = "Complete" Then

有许多If - Then,With和Loop结构没有用匹配正确终止End。我试图解决这个问题 - 确保我做对了。请注意，使用适当的缩进确实有助于发现这样的问题。空格键是你的朋友...

由于该Find方法返回一个对象，因此使用该函数的正确方法是

Set g = .Find(Range("G" & i).Text, LookIn:=xlValues)

除此之外 -Option Explicit在代码顶部使用，并使用您可以使用的最严格（正确）类型定义变量。当我这样做时，我发现我无法纠正的错误 -rngCell既没有声明也没有设置的变量......它显示了它的帮助。也有助于捕捉错别字——VBA 很乐意让你写出类似的东西

myVar = 1 消息框 myVra + 1

该消息将是1，不是，因为错字......甚至应该是一个选项2的事实是 VBA 团队做出的许多莫名其妙的设计决策之一。Explicit

这是您的代码“修复了大部分错误”。至少像这样它会编译 - 但你必须弄清楚如何处理剩余的错误（我不能确定我猜对了你想对标记为“完成”的单元格做什么）。

欢迎评论。

Option Explicit

Sub FindCpy()
Dim lw As Long
Dim i As Integer
Dim sh As Worksheet
Dim dupRow As Integer
Dim g As Range
Dim firstAddress As Range

'Used for the new worksheet we are pasting into
Dim objNewSheet As Worksheet
Dim rngNextAvailbleRow As Range

'Used to narrow down the logical operators for duplicates
Dim rngFirst As Range

'Set the ranges
rngFirst = Range("G" & 1, "G" & lw)

Set sh = Sheets("Completed")
lw = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To lw 'Find duplicates from the list.
'  If Application.CountIf(Range("A" & i & ":A" & lw), Range("A" & i).Text) = "Complete" Then
   If Range("A" & i).Text = "Complete" Then
   'if COMPLETE, check the rest of the sheet for any 'in progress' duplicates...
    With Worksheets("Still In Progress").rngFirst
      Set g = .Find(Range("G" & i).Text, LookIn:=xlValues)
        If Not g Is Nothing Then
          firstAddress = g.Address
          dupRow = firstAddress.Row
          If Range("H" & dupRow).Text = Range("H" & i).Text _
            And Range("I" & dupRow).Text = Range("I" & i).Text _
            And Range("J" & dupRow).Text = Range("J" & i).Text Then

            'select the entire row
            g.EntireRow.Select

            'copy the selection
            Selection.Cut

            'Now identify and select the new sheet to paste into
            Set objNewSheet = ThisWorkbook.Worksheets("Completed")
            objNewSheet.Select

            'Looking at your initial question, I believe you are trying to find the next     available row
            Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)

            Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
            ActiveSheet.Paste

            'delete the initial row
            rngCell.EntireRow.Delete  ' <<<<<< the variable rngCell was never defined. Cannot guess what you wanted to do here!

            Do
              Set g = .FindNext(g)
              Loop While Not g Is Nothing And g.Address <> firstAddress

          End If ' entire row matched
        End If   ' Not g Is Nothing
      End With   ' With Worksheets("Still in Progress")
    End If       ' CountIf = "Complete"

  Next i

End Sub

另一个方便的技巧：当你“粘贴到下一个可用行”时Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select，我通常会发现做这样的事情很方便：

Dim destination As Range
Set destination = Worksheets("Sheetname").Range("A1")

当你需要粘贴一些东西时：

destination.Select
ActiveSheet.Paste
Set destination = destination.Offset(1,0)

这样，destination始终指向“我可以粘贴的下一个位置”。我觉得它很有帮助而且更干净。

于 2013-08-13T12:51:50.323 回答