麻辣家族討論版版 - Powered by Discuz! Board

標題: (已解決)如何用搜尋找資料後複製該位置以下的資料? [打印本頁]

作者: freeffly 時間: 2012-2-22 16:00 標題: (已解決)如何用搜尋找資料後複製該位置以下的資料?

本帖最後由 freeffly 於 2012-3-6 13:43 編輯

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

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

[attach]9694[/attach]

作者: hugh0620 時間: 2012-2-22 17:07

回復 1# freeffly

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

Private Sub Worksheet_Change(ByVal Target As Range)
Dim E As Worksheet
If Target.Column = 3 And Target.Row = 1 Then
N = 2
A = Sheet1.Range("C1")
Sheet1.Range("A2:D65536").ClearContents
For Each E In Sheets
If E.Index <> 1 Then
Set F = E.Range("A1:IV1").Find(A, LookIn:=xlValues)
If Not F Is Nothing Then
K = E.Range("A1:IV1").Find(A).Column
I = 4
Do Until E.Cells(I, 1) = ""
With E
Sheet1.Cells(N, 1) = E.Cells(I, 1)
Sheet1.Cells(N, 2) = E.Cells(I, 2)
Sheet1.Cells(N, 3) = E.Cells(I, K)
Sheet1.Cells(N, 4) = E.Cells(I, K).Offset(0, 1)
N = N + 1
End With
I = I + 1
Loop
End If
End If
Next
End If
End Sub

複製代碼

作者: freeffly 時間: 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  這個的意思是?

作者: hugh0620 時間: 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也被計算~ 有可能會造成錯誤~

作者: Hsieh 時間: 2012-2-22 19:41

回復 1# freeffly

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$1" Then
Application.EnableEvents = False
For Each a In Range("A2", [A2].End(xlDown))
sh = Format(a, "emm")
With Sheets(sh)
Set c = .Rows(1).Find([C1], lookat:=xlWhole)
r = Application.Match(a, .[A:A], 0)
If IsNumeric(r) And Not c Is Nothing Then a.Offset(, 2) = .Cells(r, c.Column) Else a.Offset(, 2) = ""
End With
Next
End If
Application.EnableEvents = True
End Sub

複製代碼

作者: freeffly 時間: 2012-2-23 08:36

回復 4# hugh0620

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

作者: freeffly 時間: 2012-2-23 08:41

回復 5# Hsieh

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

作者: freeffly 時間: 2012-2-23 09:09

回復 5# Hsieh

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

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

作者: freeffly 時間: 2012-2-23 09:29

回復 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 時間: 2012-2-23 09:31

回復 7# freeffly

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

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

作者: hugh0620 時間: 2012-2-23 09:37

回復 Hsieh

仔細看過後板主的方式與另外一位大大方式不同(處理方式)
如果說想要向另一位大 ...
freeffly 發表於 2012-2-23 09:09

樓主你用的SHEET.Name是民國+年~
所以H大大用sh = Format(a, "emm")的方式~ 來判斷你的SHEET名稱
然後再進去那個SHEET中撈取資料

作者: GBKEE 時間: 2012-2-23 09:52

回復 10# hugh0620

r = Application.Match(a, .[A:A], 0)
If IsNumeric(r) And Not c Is Nothing Then a.Offset(, 2) = .Cells(r, c.Column) Else a.Offset(, 2) = ""

複製代碼

Match函數 :找到時傳回數字, 找不到時傳回 "#N/A" (錯誤值)
改成 If Not IsError(r) And Not c Is Nothing Then 就可以除錯

作者: Hsieh 時間: 2012-2-23 10:53

回復 8# freeffly

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$1" Then
Application.EnableEvents = False
Range("A1").CurrentRegion.Offset(1, 2) = ""
For Each a In Range("A2", [A2].End(xlDown))
sh = Format(a, "emm")
For Each sht In Sheets
If sht.Name = sh Then
With sht
Set c = .Rows(1).Find([C1], lookat:=xlWhole)
r = Application.Match(a, .[A:A], 0)
If IsNumeric(r) And Not c Is Nothing Then a.Offset(, 2).Resize(, 2).Value = .Cells(r, c.Column).Resize(, 2).Value
End With
End If
Next
Next
End If
Application.EnableEvents = True
End Sub

複製代碼

作者: freeffly 時間: 2012-2-23 13:18

回復 10# hugh0620

這個我有發現
你們倆各的處理方式不一樣
都是學習的方式

作者: freeffly 時間: 2012-2-23 13:26

回復 13# Hsieh

謝謝版主
有想到用resize可是沒試出來
原來是差在.value

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)