![](/img/trans.png)
[英]Excel VBA code to select cells that contain a certain text string in one workbook, and then copy and paste these cells into a new workbook
[英]Excel VBA to select cells that contain a text string, and then copy and paste these cells into a new workbook
我是一個狂熱的 excel 用戶,但不擅長 vba。 任何幫助表示贊賞。 以下是我正在嘗試執行的步驟。
在 B 列中查找文本字符串。 - 使用偏移量收集位於此字符串周圍的兩個值。 offset(4,0) 和 offset(3,10) - 總共執行四次,得到 8 個值。 - 將 8 個值粘貼到另一個工作簿中最后一行的 8 個連續單元格中
Set wkb = Excel.Workbooks.Open("c:\users\jojames\desktop\skillset performance with talktime.xls")
Set wks = wkb.Worksheets("Sheet1"): wks.Activate
find1Allscripts = "Allscripts - 10055"
Set Match1 = wks.Cells.Find(find1Allscripts)
findoffset1a = Match1.Offset(4, 0).Value
findoffset1b = Match1.Offset(3, 10).Value
find2Tier1 = "Tier1_ServiceDesk - 10052"
Set Match2 = wks.Cells.Find(find2Tier1)
findoffset2a = Match2.Offset(4, 0).Value
findoffset2b = Match2.Offset(3, 10).Value
find3Tier2 = "Tier2_ServiceDesk - 10053"
Set Match3 = wks.Cells.Find(find3Tier2)
findoffset3a = Match3.Offset(4, 0).Value
findoffset3b = Match3.Offset(3, 10).Value
find4Office = "Allscripts - 10055"
Set Match4 = wks.Cells.Find(find4Office)
findoffset4a = Match4.Offset(4, 0).Value
findoffset4b = Match4.Offset(3, 10).Value
'Paste the values'
Set wkb2 = ThisWorkbook
Set wks2 = wkb2.Sheets("ACD Data")
wks2.Activate
LastRow = wks2.Range("Y" & wks2.Rows.Count).End(xlUp).Row + 1
ActiveSheet.Range("Y" & LastRow).PasteSpecial xlPasteFormulas
Set wks = Nothing: Set wkb = Nothing
Set wks2 = Nothing: Set wkb2 = Nothing
我認為這是一個不錯的開始。 我會將我正在搜索的內容存儲在一個數組中並循環遍歷它
myArray = Array("Allscripts -1005", "Tier1_ServiceDesk - 10052", ...)
for i = lbound(myArray) to ubound(myArray)
Set Match1 = wks.Cells.Find(myArray(i))
if not Match1 is Nothing then
LastRow = wks2.Range("Y" & wks2.Rows.Count).End(xlUp).Row + 1
wks2.Range("Y" & LastRow) = Match1.Offset(4,0).Value
wks2.Range("Z" & LastRow) = Match1.Offset(3,10).Value
end if
next i
順便說一下,不需要選擇或激活任何東西。 就像我一樣把它稱為一個對象。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.