时间戳

首页 > 解决方案 > VBA 宏忽略 nextBlankRow 并重复

excel - VBA 宏忽略 nextBlankRow 并重复

问题描述

我希望宏完成的任务：

我希望用户能够在电子表格上填写从 E2 到 E9 的数据。当用户按下“添加汽车”按钮时，应该执行宏。然后，makro 应该获取手写数据，从 E2:E9 复制所有内容并将其放入以 C13 开头并跨越 7 列的表中，始终将新数据集放在下一个空闲行中。它还应该检查重复项并发出警报，同时不覆盖原始数据集

所以我的问题是，我希望我正在编写的宏将信息放入某些单元格中，然后将它们复制到下面的表格中。

我正在像这样启动宏

Sub addData()

Dim lastrow As Long, nextBlankRow As Long
lastrow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlPrevious, _
MatchCase:=False).Row

nextBlankRow = lastrow + 1

在这里，我尝试定义宏应该如何找到最后一个空单元格，并定义 lastrow 和 nextBlankRow。

在那之后，我从一个简单的If陈述开始，看看这个人是否在E2同一张纸上至少有一些东西。

If Range("E2") = "" Then
     MsgBox "Wählen Sie ein KFZ aus!"
     Range("E2").Select
  Exit Sub
End If

这行得通。当我不把东西放进E2去时，我会得到带有警报的文本框。

无论如何，如果没有触发 IF 语句退出子，则会向宏提供指令以获取信息并将其放在下表中

Cells(nextBlankRow, 3) = Range("E2")
Cells(nextBlankRow, 4) = Range("E3")
Cells(nextBlankRow, 5) = Range("E4")
Cells(nextBlankRow, 6) = Range("E5")
Cells(nextBlankRow, 7) = Range("E6")
Cells(nextBlankRow, 8) = Range("E7")
Cells(nextBlankRow, 9) = Range("E8")

这似乎是一个可能与我未能正确定义变量有关的问题？

因为宏找到正确的行但只覆盖该行。所以它忽略了它“应该”跳到我之前定义为的 nextBlankrow 的事实

nextBlankRow = lastrow + 1

除此之外，我还有一行代码用于检查重复项

Dim p As Long, q As Long
p = 13
q = p + 1
Do While Cells(p, 3) <> ""
    Do While Cells(q, 3) <> ""
        If Cells(p, 3) = Cells(q, 3) And Cells(p, 4) = Cells(q, 4) Then
            MsgBox "Datensatz schon vorhanden!"
            Range(Cells(q, 3), Cells(q, 9)).ClearContents
        Else
        q = q + 1
        End If
    Loop
p = p + 1
q = p + 1
Loop

End Sub

这总是给出错误的回报。因此，即使同一组数据被复制两次到同一行（因为它确实如此），它也只会“刷新”数据并且不会说“你不允许这样做”。

我在这里不知所措。

这是易于使用的完整代码

Sub addData()

Dim lastrow As Long, nextBlankRow As Long
lastrow = Cells.Find(What:="*", _
After:=Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlPrevious, _
MatchCase:=False).Row

nextBlankRow = lastrow + 1


If Range("E2") = "" Then
        MsgBox "Wählen Sie ein KFZ aus!"
        Range("E2").Select
    Exit Sub
End If

  Cells(nextBlankRow, 3) = Range("E2")
  Cells(nextBlankRow, 4) = Range("E3")
  Cells(nextBlankRow, 5) = Range("E4")
  Cells(nextBlankRow, 6) = Range("E5")
  Cells(nextBlankRow, 7) = Range("E6")
  Cells(nextBlankRow, 8) = Range("E7")
  Cells(nextBlankRow, 9) = Range("E8")


Dim p As Long, q As Long
p = 13
q = p + 1
Do While Cells(p, 3) <> ""
    Do While Cells(q, 3) <> ""
        If Cells(p, 3) = Cells(q, 3) And Cells(p, 4) = Cells(q, 4) Then
            MsgBox "Datensatz schon vorhanden!"
            Range(Cells(q, 3), Cells(q, 9)).ClearContents
        Else
        q = q + 1
        End If
    Loop
p = p + 1
q = p + 1
Loop


End Sub
```![enter image description here](https://i.stack.imgur.com/dJozM.jpg)![enter image description here](https://i.stack.imgur.com/Q90Ah.jpg)

标签： excelvba

解决方案

请测试下一个代码：

Sub copyRangeOnLastEmptyRow()
 Dim sh As Worksheet, arr, lastERow As Long, matchCel As Range
 
 Set sh = ActiveSheet
 arr = sh.Range("E2:E9").value
 lastERow = sh.Range("C" & sh.rows.Count).End(xlUp).row + 1
 If lastERow < 13 Then lastERow = 13
 'check if the range has not been alredy copied:
 Set matchCel = sh.Range("C13:C" & lastERow - 1).Find(WHAT:=sh.Range("E2").value, LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False)
 If Not matchCel Is Nothing Then
    MsgBox sh.Range("E2").value & " has been found in cell " & matchCel.Address & "."
    'bring up the data of the existing row:
    sh.Range("E3:E9").value = Application.Transpose(sh.Range(matchCel.Offset(0, 1), matchCel.Offset(0, 7)).value)
    Exit Sub
End If
 sh.Range("C" & lastERow).Resize(1, UBound(arr)).value = Application.Transpose(arr)
 sh.Range("E2:E9").ClearContents
End Sub

推荐阅读