Question

我正在尝试通过

修复缺少的条目

找到它然后
将相对于找到的条目的最左侧单元格值复制到另一个工作表的第一个空底单元格。

我是VBA的新手，不知道如何解决这个问题。这可能不难做到，我只是无法从我拥有的vba书中弄明白。

   With Worksheets("Paste Pivot").Range("A1:AZ1000")
   Dim source As Worksheet
   Dim destination As Worksheet
   Dim emptyRow As Long
   Set source = Sheets("Paste Pivot")
   Set destination = Sheets("User Status")
   Set c = .Find("MissingUserInfo", LookIn:=xlValues)
   If Not c Is Nothing Then
    firstAddress = c.Address
    Do
                   'Here would go the code to locate most left cell and copy it into the first empty bottom cell of another worksheet  
       emptyRow = destination.Cells(destination.Columns.Count, 1).End(xlToLeft).Row
       If emptyRow > 1 Then
       emptyRow = emptyRow + 1
       End If
       c.End(xlToLeft).Copy destination.Cells(emptyRow, 1)
        c.Value = "Copy User to User Status worksheet"

        Set c = .FindNext(c)
        If c Is Nothing Then Exit Do
    Loop While c.Address <> firstAddress
End If
End With

***更新我在其他地方找到了答案，它可能效率不高，但现在是：

With Worksheets("Paste Pivot").Range("A1:AZ1000")
Dim source As Worksheet
Dim sourceRowNumber As Long
Dim destination As Worksheet
Dim destCell As Range
Dim destCellRow As Long
Set source = Sheets("Paste Pivot")
Set destination = Sheets("User Status")
Set c = .Find("MissingUserInfo", LookIn:=xlValues)
If Not c Is Nothing Then
    firstAddress = c.Address
    Do

      With destination
       Set destCell = .Cells(.Rows.Count, "A").End(xlUp)
       destCellRow = destCell.Row + 1
        End With

       sourceRowNumber = c.Row

       destination.Cells(destCellRow, 1).Value = source.Cells(sourceRowNumber, 1)
       destination.Cells(destCellRow, 2).Value = source.Cells(sourceRowNumber, 2)
       destination.Cells(destCellRow, 3).Value = source.Cells(sourceRowNumber, 3)

       c.Value = "Run Macro Again"

        Set c = .FindNext(c)
        If c Is Nothing Then Exit Do
    Loop While c.Address <> firstAddress
End If
End With

谢谢你，Madi

Answer 1

我认为CurrentRegion会帮助你。

e.g。如果您在A1：E4范围内的每个单元格中都有一个值，那么

Cells(1,1).CurrentRegion.Rows.Count等于4和

Cells(1,1).CurrentRegion.Columns.Count等于5

因此你可以写：

c.End(xlToLeft).Copy _
    destination.Cells(destination.Cells(1).CurrentRegion.Rows.Count + 1, 1)

如果您在目标电子表格中间没有任何间隙，则会将使用“MissingUserInfo”（在“Paste Pivot”表单中）的行开头的用户ID复制到第一个单元格“用户状态”表格末尾的新行。

然后你的Do Loop变为：

Do
    c.End(xlToLeft).Copy _
        destination.Cells(destination.Cells(1).CurrentRegion.Rows.Count + 1, 1)
    c.Value = "Copy User to User Status worksheet"
    Set c = .FindNext(c)
    If c Is Nothing Then Exit Do
Loop While c.Address <> firstAddress

Answer 2

由原始海报原始编辑为问题的答案：

With Worksheets("Paste Pivot").Range("A1:AZ1000")
Dim source As Worksheet
Dim sourceRowNumber As Long
Dim destination As Worksheet
Dim destCell As Range
Dim destCellRow As Long
Set source = Sheets("Paste Pivot")
Set destination = Sheets("User Status")
Set c = .Find("MissingUserInfo", LookIn:=xlValues)
If Not c Is Nothing Then
    firstAddress = c.Address
    Do

      With destination
       Set destCell = .Cells(.Rows.Count, "A").End(xlUp)
       destCellRow = destCell.Row + 1
        End With

       sourceRowNumber = c.Row

       destination.Cells(destCellRow, 1).Value = source.Cells(sourceRowNumber, 1)
       destination.Cells(destCellRow, 2).Value = source.Cells(sourceRowNumber, 2)
       destination.Cells(destCellRow, 3).Value = source.Cells(sourceRowNumber, 3)

       c.Value = "Run Macro Again"

        Set c = .FindNext(c)
        If c Is Nothing Then Exit Do
    Loop While c.Address <> firstAddress
End If
End With

Excel VBA宏：将相对单元格复制到另一个工作表

2 个答案: