Board logo

標題: [發問] 請問如何快速比對資料 [打印本頁]
作者: chen255    時間: 2012-3-9 18:32     標題: 請問如何快速比對資料

Dear 大大,

有請點問題想請教各位.
(1)
B = Sheets("B資料庫").Range([A2], [A65536].End(xlUp))
For Each A In B
if A = 1101 Then
  ............(省略)
End If
Next A

程式會比對A2 ~ A65536內 所有的儲存值 , 不過有沒有什麼方式可以讓當程式一比對到if條件成立時 , 就不用繼續比對後面的儲存格了?

(2)
以附件範例為例.
在sheet1[c1]輸入股號 , sheet1[AE2]&[AC2]輸入搜尋年分範圍後 , 然後去比對sheet2 , 再將比對成功的資料複製到sheet1[ACx : AIx].
以附件為例 , shee2[a12]是台泥一月份 , 雖然我們已知二月份台泥是[a12].offset(0, 10) , 不過難免會有新股號加入 , 所以搜尋下個月份時還重頭開始搜尋起 , 不過至少每個月份的資料都是隔10格

小弟以For Each指令可以做到類似的功能 , 不過只能成功複製第一個月份 , 而且速度很慢.
想請教各位先進有沒有其它指令及什麼方式可以做到這樣的功能.

[attach]9930[/attach]
作者: Hsieh    時間: 2012-3-9 18:49

本帖最後由 Hsieh 於 2012-3-9 23:51 編輯

回復 1# chen255
可使用FIND找到列位
但看不懂你的欄位對應
如果執行結果有誤，請以附件中的範例填入Sheet1來說明
  1. Sub nn()
  2. Dim A As Range, B As Range
  3. With Sheet1
  4. For Each A In .Range(.[AB4], .[AB4].End(xlDown))
  5.    ym = Val(Split(A, "/")(0)) & "年" & Val(Split(A, "/")(1)) & "月"
  6.    Set B = Sheet2.Rows(1).Find(ym, lookat:=xlPart)
  7.    Set c = B.EntireColumn.Find(.[C1])
  8.    A.Offset(, 1).Resize(, 7).Value = Array(c.Offset(, 2), c.Offset(, 5), c.Offset(, 4), c.Offset(, 6), c.Offset(, 7), c.Offset(, 8), c.Offset(, 9))
  9. Next
  10. End With
  11. End Sub
複製代碼
作者: register313    時間: 2012-3-9 22:36

本帖最後由 register313 於 2012-3-10 14:51 編輯

回復 1# chen255
  1. Sub 月營收明細()
  2. With Sheets("Main")
  3.   .[AB1].CurrentRegion.Offset(3, 0) = ""
  4.   For Y = .[AC2] To .[AE2]
  5.     For M = 1 To 12
  6.       Sheets(Y & "營業收入").Activate
  7.       Set Source = Sheets(Y & "營業收入").Range([A12].Offset(0, (M - 1) * 10), [J65536].Offset(0, (M - 1) * 10).End(xlUp))
  8.       Set Code = Source.Find(.[C1], , , xlWhole)
  9.       R = .[AB65536].End(xlUp).Row + 1
  10.       If Not Code Is Nothing Then
  11.         .Range("AB" & R) = Y & "/" & Format(M, "00")
  12.         .Range("AC" & R, "AI" & R) = Array(Code.Offset(, 2), Code.Offset(, 5), Code.Offset(, 4), Code.Offset(, 6), Code.Offset(, 7), Code.Offset(, 8), Code.Offset(, 9))
  13.       End If
  14.     Next M
  15.   Next Y
  16. End With
  17. End Sub
複製代碼
作者: chen255    時間: 2012-3-13 09:48

這幾天 工作量很大 到現在才上來看帖 ,
這裡先感謝Hsieh & register313 兩位先進 , 小弟晚一點再將測試結果貼上來 , 謝謝.
作者: chen255    時間: 2012-3-13 09:49

回復 2# Hsieh

小弟晚一點再將測試結果貼上來 , 謝謝.
作者: chen255    時間: 2012-3-13 09:49

回復 3# register313


    小弟晚一點再將測試結果貼上來 , 謝謝.
作者: chen255    時間: 2012-3-18 00:29

回復 3# register313

Dear register313大大

你好 , 有個問題想請教.

Sheets(Y & "營業收入").Activate

為何需要執行這段動作.
作者: register313    時間: 2012-3-18 01:55

本帖最後由 register313 於 2012-3-18 02:12 編輯

回復 7# chen255

Sheets(Y & "營業收入").Activate
Set Source = Sheets(Y & "營業收入").Range([A12].Offset(0, (M - 1) * 10), [J65536].Offset(0, (M - 1) * 10).End(xlUp))
Sheets(Y & "營業收入").是多的,可不要
定義工作表之儲存格範圍時,該工作表必須為活動工作表

以上二行也可改為
Set source = Sheets(Y & "營業收入").Range(Sheets(Y & "營業收入").[A12].Offset(0, (M - 1) * 10), Sheets(Y & "營業收入").[J65536].Offset(0, (M - 1) * 10).End(xlUp))

http://forum.twbts.com/viewthread.php?tid=1294&highlight=SET
作者: chen255    時間: 2012-3-24 17:40

回復 8# register313

了解 , 再次大大的感謝說明.

另外 , 想請教另一個問題.
假設我硬碟內有1.html , 2.html , 3.html , 4html , 5.html 共五筆檔案.
有辦法將檔案匯入到想指定的excel 位置嗎?
作者: register313    時間: 2012-3-24 23:56

回復 9# chen255

excel檔 與 要匯入的html檔 放同一目錄下
  1. Sub 匯入()
  2. Dim i%
  3. Application.ScreenUpdating = False
  4. For i = 1 To 5
  5.   sFile = ThisWorkbook.Path & "\" & i & ".html"
  6.   If Dir(sFile) = "" Then GoTo NEXT_FILE
  7.      For Each Sh In Sheets
  8.          If Sh.Name = i Then
  9.             Application.DisplayAlerts = False
  10.             Sh.Delete
  11.             Application.DisplayAlerts = True
  12.          End If
  13.      Next
  14.      Sheets.Add After:=Sheets(Sheets.Count)
  15.      ActiveSheet.Name = i
  16.      Workbooks.Open Filename:=ThisWorkbook.Path & "\" & i & ".html"
  17.      Workbooks(i & ".html").Sheets("sheet1").Cells.Copy ThisWorkbook.ActiveSheet.[A1]
  18.      Workbooks(i & ".html").Close 2
  19. NEXT_FILE:
  20.    Next
  21. Application.ScreenUpdating = True
  22. MsgBox "匯入完成"
  23. End Sub
複製代碼
作者: chen255    時間: 2012-3-25 01:45

回復 10# register313


    謝謝大大的幫忙 , 我先了解一下程式的意義 , 再次感謝.



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