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

freeffly

我想要用搜尋的方式
如附檔
如果搜尋到第一各工作表[C1]的資料
就複製各個工作表第4列之後的資料

因為每各工作表排的位置有點不相同
所以目前我想到的方式是用搜尋
但是用vba我不知道該怎麼去抓


ssdsa.rar (18.08 KB)

下載次數: 24

2012-2-22 15:57

hugh0620

回復 1# freeffly


這個方式針對樓主你要彙整的sheet中C1的儲存格資料
去篩選你每一個月份的符合你C1資料的欄位,將該資料帶出來
提供給你參考試試看~
可以將C1的儲存格設定驗證的方式來挑選資料~ 會更合用~

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim E As Worksheet
   
3. 
   
4. If Target.Column = 3 And Target.Row = 1 Then
   
5. 
   
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
    
25. 
    
26.         End If
    
27.     End If
    
28. Next
    
29. End If
    
30. End Sub

複製代碼

freeffly

回復 2# hugh0620


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

2.第8行為什麼要連D也處理?
3.
E.Index  這個的意思是?

hugh0620

回復  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也被計算~ 有可能會造成錯誤~

Hsieh

回復 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

複製代碼

freeffly

回復 4# hugh0620


    恩 謝謝回覆
   我也還有很多要學

freeffly

回復 5# Hsieh


    感謝版主
   這個方式更簡潔
   速度感覺更快些
   不過有一些不懂
   消化後再提問

freeffly

回復 5# Hsieh


    仔細看過後板主的方式與另外一位大大方式不同(處理方式)
    如果說想要向另一位大大那樣抓兩欄要怎麼改

   Application.EnableEvents = False  在這裡的用處是? 要讓什麼事件不發生嗎?
   sh = Format(a, "emm")  emm有特殊規則嗎 看到版主使用才知道有這種方式

freeffly

回復 4# hugh0620

               剛試了一下 這裡還可以改這樣

                Sheet1.Cells(N, 1).Resize(, 4) = Array( _
                E.Cells(i, 1), _
                E.Cells(i, 2), _
                E.Cells(i, K), _
                E.Cells(i, K).Offset(0, 1))

hugh0620

回復 7# freeffly


    H大大是一個高手~ 我不懂的問題~ 拋出來~ 各版大或大大們都能指導解惑唷~

    H大大的程式  要有一定的條件才能執行~
    執行時要注意SHEET1的日期資料~
    若你的日期資料不包含在DATA中的日期~ 就會產生錯誤
    舉例~ 你提供的資料是9~10月~  若你SHEET1的日期在94/9/1以前或94/10/31以後的日期~
    就會產生錯誤~
     所以~ 要設一個防錯的程式碼~ 不然你執行的時候沒注意就話掛在那邊唷~