我有excel表(下面带有标题的示例示例)没有标题,其中有近8,000行。如果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之外的简单方法实现这一点,请告诉我。
答案 0 :(得分:0)
最快的方法是填充第一列。 你应该知道它已经完全填充的列上有一个循环(即第2列) 将prodID存储在变量中,并在每次prodID为&#34时使用它;" 例如:
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
答案 1 :(得分:0)
我在名为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