需要根据第一列值将数据范围从一个excel表复制到另一个

Question

我有一个没有标题的 Excel 表（下面带有标题的示例），其中包含近 8000 行。如果 A 列中的值匹配，我需要将 B、C、D 列的值复制到另一张表。另外问题是A列在每一行中都没有值。只有当它的值与前一行的值不同时才会填充它。

考虑下面的示例表：

    ProdID    Name     Prop       Reveiwer  
    1        abcName  abcProp     abcRev  
             qweName  qweProp     qweRev  
             asdName  asdProp     asdRev  
    2        jhkName  jhkProp     jhkRev  
             mnbName  mnbProp     mnbRev  
    1        eName    eProp       eRev  
             aName    aProp       aRev  

我们选择 1 时的预期输出是：

    ProdID  Name     Prop     Reveiwer  
    1      abcName  abcProp   abcRev  
           qweName  qweProp   qweRev  
           asdName  asdProp   asdRev  
           eName    eProp     eRev  
           aName    aProp     aRev 

我尝试了几种逻辑来使用 VBA 实现上述输出，但都没有奏效。

任何人都可以帮助我获得预期输出的 VBA 代码。如果这可以通过 VBA 以外的简单方法实现，请告诉我。

Answer 1

根据通用 ID 搜索和列出单元格值

我已在名为Sheet1的电子表格中重新创建了您的数据

在Sheet2 我有一张只有标题的空白纸

当我点击Sheet1 上的按钮时，系统会提示我InputBox

在本例中，我将搜索 Prod ID 值为 1。以下是 Sheet2 上的结果

我可以多次重复此操作，结果页面会自动清除旧的搜索值，只列出新的搜索。

---

代码

将以下代码放入模块中。 FindAndShow 是您要分配给第一页上的按钮形状的宏，如果您希望像我一样设置自己。

Sub FindAndShow()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
    Dim wsResult As Worksheet: Set wsResult = ThisWorkbook.Sheets(2)
    Dim prodID As String, prodRng As Range
    Dim myRowOffset As Long, mySearch As String, nextRow As Long

    'First is clearing old search items
    wsResult.Range("A2", "D" & wsResult.Cells(wsResult.Rows.Count, "B").End(xlDown).Row).Clear

    'Next we find the next blank row to start placing our results. As I have it, this will
    'always be 2 because we're clearing old data. I've left it dynamic to make modifying the
    'code easier.
    nextRow = wsResult.Range("B2", wsResult.Cells(wsResult.Rows.Count, "B").End(xlUp)).Row + 1

    'Here we take our input from the user.
    'You can change the prompt and title to fit your needs.
    prodID = InputBox("Which Production ID would you like to find?", "Production ID Search")
    Set prodRng = ws.Range("A:A").Find(What:=prodID, LookIn:=xlValues, LookAt:=xlWhole)

    'This is the loop that finds search items, and pastes them to the results page.
    'Normally having range.value = range.value would be quickest, but since we're dealing with
    'thousands of cells that are in sizable groups, the copy method will be most ideal.
    If Not prodRng Is Nothing Then
    wsResult.Range("A" & nextRow).Value = prodID
        firstResult = prodRng.Address
        Do
            myRowOffset = FindRowOffset(prodRng)
            ws.Range(prodRng.Offset(0, 1), prodRng.Offset(myRowOffset, 3)).Copy _
                wsResult.Range("B" & nextRow)
            Set prodRng = ws.Range("A:A").FindNext(prodRng)
            nextRow = nextRow + myRowOffset + 1
        Loop While Not prodRng Is Nothing And prodRng.Address <> firstResult
    End If
End Sub

Function FindRowOffset(myRange As Range) As Long
    'This functions only purpose is to see how far each search block goes.
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
    Dim i As Long: i = 1

    Do While myRange.Offset(i).Value = "" And myRange.Offset(i, 1) <> ""
        i = i + 1
    Loop
    FindRowOffset = i - 1
End Function

Answer 2

最快的方法是填充第一列。 您应该在您知道它已完全填充的列上有一个循环（即第 2 列） 将 prodID 存储在一个变量中，并在每次 prodID 为 = "" 时使用它 例如：

i=start_row
While Range("B" & i) <> ""
 if Range("A" & i) <> "" then
  prod_id=Range("A" & i)
 else
  Range("A" & i)=prod_id
 end if
 i=i+1
wend