12
返回列表 上一主題 發帖

(已解決)如何用搜尋找資料後複製該位置以下的資料?

freeffly

帖子
586 
主題
123 
精華
0 
積分
763 
點名
0  
作業系統
WINDOW7 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-16 
最後登錄
2017-3-14 

熱烈參與勳章好學求知勳章
6# 跳轉到 »
發表於 2012-2-23 08:36 | 只看該作者
回復 4# hugh0620


    恩 謝謝回覆
   我也還有很多要學
字典兩各字 還真難理解

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
5#
發表於 2012-2-22 19:41 | 只看該作者
回復 1# freeffly
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. If Target.Address = "$C$1" Then
  3. Application.EnableEvents = False
  4. For Each a In Range("A2", [A2].End(xlDown))
  5.   sh = Format(a, "emm")
  6.   With Sheets(sh)
  7.      Set c = .Rows(1).Find([C1], lookat:=xlWhole)
  8.      r = Application.Match(a, .[A:A], 0)
  9.      If IsNumeric(r) And Not c Is Nothing Then a.Offset(, 2) = .Cells(r, c.Column) Else a.Offset(, 2) = ""
  10.   End With
  11. Next
  12. End If
  13. Application.EnableEvents = True
  14. End Sub
複製代碼
學海無涯_不恥下問

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
4#
發表於 2012-2-22 17:58 | 只看該作者
本帖最後由 hugh0620 於 2012-2-22 18:03 編輯
回復  hugh0620

  幾各問題問依下
1.
  If Target.Column = 3 And Target.Row = 1 T ...
freeffly 發表於 2012-2-22 17:36


我僅是依我所知道的方式來撰寫~ 很多更深更簡化的~ 我也還在學習中~

第一個問題~
If Target.Column = 3 And Target.Row = 1 Then  exit sub
這句是讓你設定在C1這個位置才去觸發程式~
如果每一個儲存格都是篩選的位置~ 這樣寫法就有所不同

Target.Address = "$C$1"
這個我有測試過~ 也可以這樣寫~

第二個問題
2.第8行為什麼要連D也處理?
    因為有看到樓主的另外兩個DATA SHEET 前面各種幣值是兩個欄位資料~
    加上日期與星期 共有四列欄位~
   
第三個問題
     E.Index  的意思: E是活頁號碼~ 因你要存放資料的SHEET.index= 1
     而程式在執行是每一個SHEET都會被納入篩選~
     所以~ 用一個IF來判斷 避免存放資料的SHEET也被計算~ 有可能會造成錯誤~
學習才能提升自己

TOP

freeffly

帖子
586 
主題
123 
精華
0 
積分
763 
點名
0  
作業系統
WINDOW7 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-16 
最後登錄
2017-3-14 

熱烈參與勳章好學求知勳章
3#
發表於 2012-2-22 17:36 | 只看該作者
回復 2# hugh0620


   太厲害了
  幾各問題問依下
1.
  If Target.Column = 3 And Target.Row = 1 Then
這一句可以改成 Target.Address = "$C$1" 嗎

2.第8行為什麼要連D也處理?
3.
E.Index  這個的意思是?
字典兩各字 還真難理解

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
2#
發表於 2012-2-22 17:07 | 只看該作者
回復 1# freeffly


這個方式針對樓主你要彙整的sheet中C1的儲存格資料
去篩選你每一個月份的符合你C1資料的欄位,將該資料帶出來
提供給你參考試試看~
可以將C1的儲存格設定驗證的方式來挑選資料~ 會更合用~
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. Dim E As Worksheet

  4. If Target.Column = 3 And Target.Row = 1 Then

  6. N = 2
  7. A = Sheet1.Range("C1")
  8. Sheet1.Range("A2:D65536").ClearContents
  9. For Each E In Sheets
  10.     If E.Index <> 1 Then
  11.         Set F = E.Range("A1:IV1").Find(A, LookIn:=xlValues)
  12.         If Not F Is Nothing Then
  13.            K = E.Range("A1:IV1").Find(A).Column
  14.            I = 4
  15.            Do Until E.Cells(I, 1) = ""
  16.                With E
  17.                Sheet1.Cells(N, 1) = E.Cells(I, 1)
  18.                Sheet1.Cells(N, 2) = E.Cells(I, 2)
  19.                Sheet1.Cells(N, 3) = E.Cells(I, K)
  20.                Sheet1.Cells(N, 4) = E.Cells(I, K).Offset(0, 1)
  21.                N = N + 1
  22.                End With
  23.                I = I + 1
  24.             Loop

  26.         End If
  27.     End If
  28. Next
  29. End If
  30. End Sub
複製代碼
學習才能提升自己

TOP

        靜思自在 : 【蒙蔽的自由】人常在什麼都可以自由自在的時候，卻被這種隨心所欲的自由蒙蔽，虛擲時光而毫無覺知。
12
返回列表 上一主題