Board logo

標題: excel vba 查找 [打印本頁]
作者: markbaseball    時間: 2016-10-17 10:13     標題: excel vba 查找

(工作表1)                                                                     (工作表2)                           
          2001 2002 2003 2004 2005                                             
A           2      4        1        0       12                                     D  2002      8
B           3       5       0        0         7                                      F  2003      9
C           7      0       4        2          5                                     G  2001
D           0      8      9         7         2
E           7     10     11      5         8
F          6       8        9      10       0
請問我從工作表1的總檔中，查找工作表2的代號及相同年分，如果都符合的話，則把工作表1中符合的值，貼到工作表2中相對應的儲存格中
但是目前我的程式跑不動，因此希望各位高手可以幫忙看看

Sub ro()
Dim ii, kk As Integer
Dim jj As Long
Dim AA, TT As Object
  Set AA = Worksheets("工作表1")
  Set TT = .Worksheets("工作表2")
   For jj = 3 To 22355
     For ii = 2 To 1068
       For kk = 3 To 40
           Set cusip = AA.Cells(jj, 2).Find(What:=TT.Cells(ii, 6), LookIn:=xlFormulas)   '從工作表1查詢和樣本相同cusip'
           If Not cusip Is Nothing Then
                Set tdate = AA.Cells(1, kk).Find(What:=TT.Cells(ii, 2), LookIn:=xlFormulas)     '尋找相同年分'
                If Not tdate Is Nothing Then
                AA.Cells(jj, kk).Copy Destination:=TT.Cells(ii, 7)
                End If
           Else
           End If
       Next kk
     Next ii
   Next jj
End Sub
作者: lpk187    時間: 2016-10-17 10:58

本帖最後由 lpk187 於 2016-10-17 11:01 編輯

回復 1# markbaseball
善用區域變數視窗以及F8(逐步執行)來觀看你的代碼，就容易抓到問題所在了
  1. Sub ro()
  2.     Dim ro As Integer
  3.     Dim AA As Worksheet
  4.     Dim rng As Range, r As Range, c As Range
  5.     Set AA = Worksheets("工作表1")
  6.     With Sheets("工作表2") '以工作表2做目標區域
  7.         ro = .[A65535].End(xlUp).Row '尋找A欄的最後一格的列號
  8.         For Each rng In .Range("a1:a" & ro) '以A1:A(ro的數值)為範圍做循環
  9.             Set r = AA.Columns(1).Find(rng, LookIn:=xlFormulas) '在工作表1的A欄(Columns(1))，尋找代號
  10.             Set c = AA.Rows(1).Find(rng.Offset(, 1), LookIn:=xlFormulas) '在工作表1的第一列(Rows(1))，尋找年份
  11.             If Not r Is Nothing And Not c Is Nothing Then '代號和年份都找到才執行
  12.                 rng.Offset(, 2) = AA.Cells(r.Row, c.Column) '把找到的座標上的值貼到 rng(A欄) 後的第二欄(C欄)
  13.             End If
  14.             Set r =Nothing
  15.             Set c=Nothing
  16.         Next
  17.     End With
  18. End Sub
複製代碼
作者: markbaseball    時間: 2016-10-18 09:55

回復 2# lpk187


    請問一下，我工作表1的年份其實是循環的，因為不只一種資料需要查找。
    例如說:  2010 2012 2013 2014 2015 2010 2012 2013 2014 2015 一直循環下去。這樣的話，查詢row該怎麼修改呢?
作者: lpk187    時間: 2016-10-18 10:51

本帖最後由 lpk187 於 2016-10-18 10:55 編輯

回復 3# markbaseball

不好意思！我不懂你的年份循環是什麼意思，延續嗎？
我先假設是延續好了，上述程序的Set c = AA.Rows(1).Find(rng.Offset(, 1), LookIn:=xlFormulas)
就是查找年份，只要是你的年份都放在第一列(整列)，都可以找到。如果年份放在第二列，則 AA.Rows(1)改成 AA.Rows(2)，依此類推
你的問題中有2個條件，一個是找年份，一個是找代號，年份是找第一列(整列)，代號則是找A欄(整欄)

若仍有問題，建議上傳檔案
作者: markbaseball    時間: 2016-10-18 11:27

[attach]25569[/attach]回復 4# lpk187

sheet1長的是像這樣
作者: lpk187    時間: 2016-10-18 11:38

本帖最後由 lpk187 於 2016-10-18 11:44 編輯

回復 5# markbaseball


    呃！那工作表2呢？不能上傳檔案嗎？為了回答你的問題，回答的人還得作一個和你一樣的活頁簿？
這樣不一定能符合你的需求的！
還有一次說清楚你的需求是什麼，你的圖片和一樓的問題有點不一樣了！
作者: markbaseball    時間: 2016-10-18 12:30

回復 6# lpk187

因為無法直接貼檔案連結，故放在txt檔，以壓縮檔上傳連結
[attach]25571[/attach]
作者: lpk187    時間: 2016-10-18 15:36

回復 7# markbaseball
  1. Sub ro()
  2.     Dim ro As Range, co As Range
  3.     Dim AA As Worksheet, bb As Worksheet
  4.     Dim rng As Range, r As Range, shco As Range
  5.     Dim crng As Range, ng As Range
  6.     Set AA = Worksheets("工作表1")
  7.     Set bb = Worksheets("工作表2")
  8.     Set ro = bb.[D65535].End(xlUp)
  9.     Set co = bb.[E1].End(xlToRight)
  10.     Set shco = AA.[c1].End(xlToRight)
  11.     For Each rng In bb.Range("D2", ro.Address)
  12.         If rng <> "" Then
  13.         Set r = AA.Columns(2).Find(rng, LookIn:=xlFormulas)
  14.         For Each crng In bb.Range("e1", co)
  15.             For Each ng In AA.Range("c1", shco.Address)
  16.                 If ng.Value & ng.Offset(1).Value Like rng.Offset(, -2) & crng.Value & "*" Then
  17.                     If Not r Is Nothing And Not ng Is Nothing Then
  18.                         bb.Cells(rng.row, crng.column) = AA.Cells(r.row, ng.column)
  19.                     End If
  20.                     Exit For
  21.                 End If
  22.             Next
  23.         Next
  24.         Set r = Nothing
  25.         End If
  26.     Next
  27. End Sub
複製代碼
作者: markbaseball    時間: 2016-10-18 23:35

回復 8# lpk187


    太厲害了!!不過可以請大大稍微解說一下嗎?
             For Each crng In bb.Range("e1", co)
             For Each ng In AA.Range("c1", shco.Address)
            這裡看不適頗懂耶!
作者: lpk187    時間: 2016-10-19 15:24

回復 9# markbaseball

上述程序代碼都是很基礎的語句，若你有善用區域變數視窗以及F8(逐步執行)來觀看其代碼的話。其實不用解釋，
就可以很容易的觀察其程序的內容以及意思，會比我解釋，更容易理解！！
以下代碼為了解釋，修改了變數名稱(容易觀看)，其內容也有做稍微的修正。
  1. Sub ro()
  2.     Dim sht2EndRow As Range, sht2EndColumn As Range
  3.     Dim sht_1 As Worksheet, sht_2 As Worksheet
  4.     Dim rng As Range, findCusIP As Range, sht1EndColumn As Range
  5.     Dim crng As Range, ng As Range
  6.     Set sht_1 = Worksheets("工作表1")
  7.     Set sht_2 = Worksheets("工作表2")
  8.     Set sht2EndRow = sht_2.[D65535].End(xlUp) '找 工作表2 的 D欄 最後一儲存格，其語句的意思為：從儲存格的D65535往上找，找到有值的儲存格，這裡一定要往上找，因為D欄為不連續的範圍(有空的儲存格)，
  9.     Set sht2EndColumn = sht_2.[E1].End(xlToRight) '找 工作表2 的 第一列 的最後一儲存格，其語句的意思為：從 E1 往右找到最後有值的儲存格
  10.     Set sht1EndColumn = sht_1.[c1].End(xlToRight) '找 工作表1 的 第一列 的最後一儲存格
  11.    
  12.     For Each rng In sht_2.Range("D2", sht2EndRow) '以工作表2的 D2 到 D欄 最後一儲存格的範圍做迴圈循環，這裡指向的範圍是 D2:D1068
  13.         If rng <> "" Then '如果 目標儲存格 rng 不為空值才執行內部語句
  14.             Set findCusIP = sht_1.Columns(2).find(rng, LookIn:=xlFormulas) '先找到 CusIP 在B欄的哪一 列 的儲存格
  15.             If Not findCusIP Is Nothing Then '如果有找到 CusIP才執行下列語句
  16.                 For Each crng In sht_2.Range("e1", sht2EndColumn) '以工作表2 的 第一列 從 E1 到 第一列 的最後一儲存格的範圍做迴圈循環，這裡指向的範圍是 E1:I1
  17.                     ''''''下面迴圈開始尋找
  18.                     For Each ng In sht_1.Range("c1", sht1EndColumn) '以工作表1 的 C1:KT1 做範圍 比對年份以及其下一格的儲存格內容，比如：1978Return on Equity[Y78]
  19.                         ''''''下列的 ng.Value & ng.Offset(1).Value(工作表1的 年份和名稱) 和 rng.Offset(, -2) & crng.Value & "*"(工作表2的年份和名稱) 做比對
  20.                         ''''''這裡的 "*" 是把工作表1的第二列名稱中的中括號以及其內容去除掉(說是去除掉，但應該說可以是任何的內容)
  21.                         If ng.Value & ng.Offset(1).Value Like rng.Offset(, -2) & crng.Value & "*" Then
  22.                             sht_2.Cells(rng.row, crng.column) = sht_1.Cells(findCusIP.row, ng.column) '比對成功後寫入儲存格，比如說 E2、F2、G2、H2、I2 依此類推
  23.                             Exit For
  24.                         End If
  25.                     Next
  26.                     '''''''''''''
  27.                 Next
  28.             End If
  29.             Set findCusIP = Nothing '當次的迴圈結束後，設定為沒有物件，以利下個迴圈搜尋，沒設的話，則有可能找到錯誤的資料
  30.         End If
  31.     Next
  32. End Sub
複製代碼
作者: cjw    時間: 2016-10-25 11:26

Sub 查找()
Dim xR%, xY%, zR%, j%, xC%
Set SH1 = Sheet1
Set SH2 = Sheet2
xR = SH1.Cells(Rows.Count, "A").End(3).Row
xY = SH1.Cells(1, Columns.Count).End(xlToLeft).Column
Ar = SH1.Cells(1, 1).Resize(xR, xY)
zR = SH2.Cells(Rows.Count, "A").End(3).Row
With SH2
For j = 2 To zR
xC = SH1.Rows(1).Find(.Cells(j, "B")).Column
.Cells(j, "C") = Application.VLookup(.Cells(j, "A"), Ar, xC, 0)
Next
End With
End Sub
作者: laiglook    時間: 2022-4-8 17:29

很厲害的邏輯
作者: hcm19522    時間: 2022-4-9 14:38

https://blog.xuite.net/hcm19522/twblog/590330682



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