返回列表 上一主題 發帖

[發問] 請教如何讓VBA自動比對相同數值後,複製到它處?

jonn0510

帖子
38 
主題
13 
精華
0 
積分
84 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
20 
性別
男 
註冊時間
2011-12-10 
最後登錄
2021-7-18 

2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2012-8-5 08:56 | 只看該作者

[發問] 請教如何讓VBA自動比對相同數值後,複製到它處?

請教老師:
儲存格E 若等於 儲存格C 時,則複製("B:H") 到M3 如何用VBA來判斷?謝謝
如附件
B      C    D     E      F      G    H
1        17        -6        06        07        16        20
2        14        -6        06        11        16        20
3        26        -5        26        06        16        20
4        20        -9        06        16        22        27
5        17        -6        06        07        16        27
6        17        -6        17        16        20        22
7        -9        -6        06        06        16        31
------------------------------------
B      C    D     E      F      G    H
3        26        -5        26        06        16        20
6        17        -6        17        16        20        22

xx.rar (2.14 KB)

收藏 分享
感謝各位老師花心思教導

jonn0510

帖子
38 
主題
13 
精華
0 
積分
84 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
20 
性別
男 
註冊時間
2011-12-10 
最後登錄
2021-7-18 

2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章
5#
發表於 2012-8-19 20:47 | 只看該作者
回復 4# diabo

diabo大大:
不好意思,這麼久才回覆,因為小弟不太能理解 所謂的 SQL 的做法,因此去查了一下書.
可惜有看沒有懂!不過還是要感謝您願意提供方案.謝謝您
感謝各位老師花心思教導

TOP

diabo

帖子
79 
主題
2 
精華
0 
積分
193 
點名
0  
作業系統
Winwos 7 64 bits 
軟體版本
Excel 2003/2007 
閱讀權限
20 
性別
男 
來自
TAIPEI 
註冊時間
2010-8-25 
最後登錄
2019-9-20 
4#
發表於 2012-8-6 00:35 | 只看該作者
回復 3# jonn0510

資料龐大可以考慮 SQL 的做法  
記得
1. 設定引用項目 Microsoft ActiveX Data Objects 2.8 Library
2. Sheet1的B2:H2 空白的補上欄位名稱...
  1. Sub test()

  3. '建立ADODB Connection物件變數
  4. Dim cn As ADODB.Connection
  5. Set cn = New ADODB.Connection

  7. '建立ADODB Recordset物件變數
  8. Dim rs As ADODB.Recordset
  9. Set rs = New ADODB.Recordset
  10.          
  11. '建立資料庫連線
  12. With cn
  13.      .Provider = "MSDASQL"
  14.      .ConnectionString = "Driver={Microsoft Excel Driver (*.xls)};" & _
  15.       "DBQ=" & ThisWorkbook.FullName & ";"
  16.      .Open
  17. End With

  19. 'SQL字串
  20. mySQL = "Select * FROM [Sheet1$B2:H25] WHERE [主]=[副]"
  21.      
  22. '解決無法釋放記憶體的BUG
  23. ThisWorkbook.ChangeFileAccess xlReadOnly
  24. Set rs = cn.Execute(mySQL)
  25. ThisWorkbook.ChangeFileAccess xlReadWrite
  26.          
  27. '將結果COPY到指定位置
  28. Sheets("Sheet1").Range("M12").CopyFromRecordset rs

  30. End Sub
複製代碼
diabo

TOP

jonn0510

帖子
38 
主題
13 
精華
0 
積分
84 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
20 
性別
男 
註冊時間
2011-12-10 
最後登錄
2021-7-18 

2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章
3#
發表於 2012-8-5 20:31 | 只看該作者
回復 2# kimbal
kimbal老師:
感謝您的指導,謝謝您
另外您提到"其實,可以考慮一下用篩選 復制方法, 不用慢慢對代碼".原本有打算用篩選,但是資料很龐大,且經常會用到,於是想一勞永逸.所以才會上網請教.

非常感謝您
感謝各位老師花心思教導

TOP

kimbal

帖子
472 
主題
5 
精華
0 
積分
485 
點名
0  
作業系統
Windows 
軟體版本
MS Office 
閱讀權限
100 
性別
男 
來自
香港 
註冊時間
2010-7-4 
最後登錄
2014-12-28 

論壇貢獻勳章
2#
發表於 2012-8-5 13:02 | 只看該作者
  1. Sub test()
  2.     Dim outRow As Long
  3.     outRow = 0
  4.     For Each C In Range(Range("C3"), Range("C3").End(xlDown))
  5.         If C.Value = C.Offset(0, 2) Then
  6.             Range(C.Offset(0, -1), C.Offset(0, 5)).Copy
  7.             Range("M3").Offset(outRow).PasteSpecial
  8.             outRow = outRow + 1
  9.         End If
  10.     Next
  11. End Sub
複製代碼
其實,可以考慮一下用篩選 復制方法, 不用慢慢對代碼
懂得發問,答案就會在其中

今日の一秒は  明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

        靜思自在 : 小事不做、大事難成。
返回列表 上一主題