VBA 重複查找詢問

excel vba office

希臘吐舌頭 2018-05-03 17:46:55 ‧ 6762 瀏覽

如題

有幾個問題想請教各位大大

Windows("Source.xls").Activate
ActiveSheet.Range("I:I").Find("1").EntireRow.Select
Selection.Copy
Windows("Reprot.xlsx").Activate
I = ActiveCell.SpecialCells(xlLastCell).Row + 1
Cells(I, 1).PasteSpecial xlPasteAll

我在執行之後為什麼是複製到A4那一列而並非A1
要如何才能把剩餘I行內有含"1"的字串整列複製並貼上到Report裡面呢?(不重複)
2-1.要是沒有I行內都沒有"1"的話，就略過錯誤訊息繼續執行後面指令?
(我有嘗試把I行的"1"都拿掉結果執行就跳錯誤了)
若是要反向搜尋的話(I排內非"1"的都要)

因程式方面比較生疏，故懇請大大們賜教

看更多先前的討論...收起先前的討論...

q00153 iT邦新手 3 級 ‧ 2018-05-03 18:16:55 檢舉

我有一個想法，
step1. 把所有資料都複製到 Reprot.xlsx 的 sheet
step2. 把 I 欄不符合保留條件的資料那行刪除 (使用迴圈)
step3. 剩下的就是你需要的

這樣的優點有
1. 速度比一筆一筆搜尋、複製、貼上還快
2.可以自訂要保留的條件 array 方便變更條件
3.如果要更快可以把資料依照 I 欄排序後，再判斷刪除資料

paicheng0111 iT邦大師 5 級 ‧ 2018-05-04 08:32:45 檢舉

1. 到 `檢視` ，開啟 `區域變數視窗` 。
2. 用 `F8` 逐條執行你的程式。
3. 觀察 `區域變數視窗` 中，各個變數的值是否符合你的預期。

蟹老闆 iT邦大師 1 級 ‧ 2018-05-04 15:06:11 檢舉

用篩選後複製會不會比較好?

q00153 iT邦新手 3 級 ‧ 2018-05-04 15:55:55 檢舉

XD~對ㄝ
怎麼就忘記篩選了
我這腦袋.......

希臘吐舌頭 iT邦新手 5 級 ‧ 2018-05-14 11:51:38 檢舉

意思是我在I欄內先針對我要的資料篩選後在複製貼上嗎?
那另外請問若是篩選後，每個儲存列之間的空隙是也會照著貼上嗎?

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

1 個回答

海綿寶寶

iT邦大神 1 級 ‧ 2018-05-04 11:52:58

最佳解答

該認真一點
學個迴圈寫法了...
(程式沒有測過，請先使用測試資料測試)

Sub main()
   Windows("Reprot.xlsx").Activate
   Range("A1").Select
   Windows("Source.xls").Activate
   Range("A1").Select

   For Each r In Range("I1:I15")
      If ActiveCell.Value = "1" Then
         Range(ActiveCell.Offset(0, -8), ActiveCell.Offset(0, -4)).Select
         Selection.Copy
         Windows("Reprot.xlsx").Activate
         ActiveSheet.Paste
         ActiveCell.Offset(1, 0).Select
         Windows("Source.xls").Activate
      End If
      ActiveCell.Offset(1, 0).Select
   Next
End Sub

回應 5
分享
檢舉

看更多先前的回應...收起先前的回應...

希臘吐舌頭 iT邦新手 5 級 ‧ 2018-05-14 11:49:02 檢舉

海綿大抱歉那麼晚回~
我看得懂大致上的意思是從I1~I15之前尋找"1"的值
並且複製該儲存格左邊隔壁4~8格並在"Report"內貼上
然後向下一格重複尋找

測試的結果是甚麼都沒有貼過去，我有用逐步執行去看結果如下

ActiveCell是回覆是"A"欄而並非是I欄，故沒有執行下面的複製貼上
但我不確定是哪個部分可能需要修改
(因為我覺得For Each r In Range("I1:I15")這段就是指I1~I15列的尋找)
再懇請大大協助

海綿寶寶 iT邦大神 1 級 ‧ 2018-05-14 12:25:00 檢舉

沒想到你還會回來看
我只好測了一下並修正錯誤

Sub main()
   Windows("Report.xlsx").Activate
   Range("A1").Select
   Windows("Source.xlsx").Activate
   Range("A1").Select

   For Each r In Range("I1:I15")
      If r.Value = "1" Then
         Range(r.Offset(0, -8), r.Offset(0, -4)).Select
         Selection.Copy
         Windows("Report.xlsx").Activate
         ActiveSheet.Paste
         ActiveCell.Offset(1, 0).Select
         Windows("Source.xlsx").Activate
      End If
   Next
End Sub