12
返回列表 上一主題 發帖

[發問] 如何找出特定數值所對應的儲存格內容

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
11# 跳轉到 »
發表於 2012-4-13 10:06 | 只看該作者
回復 10# luke

"路人甲"多嘴
先就事論事
1.  2#  Hsieh超版 已用VBA回答您 1#之提問
      若功能有錯誤或不符您的需求
      就應即時反應,而您在4#是答覆"測試OK"
2.  論壇上超版,版主在EXCEL一般區,程式區上之功力無庸置疑
     "路人甲"不擔心超版,版主回答不出問題,只要超版,版主有時間,發問者的提問能讓超版,版主了解功能需求,都是花了時間,盡心盡力的回答
     "路人甲"在意的是發問者的提問 題目不清楚 太竉統 不附檔案 反反覆覆
3. 發帖後,每一層樓之提問,答題都應有一定的順序
    不然會讓看帖的人誤解,也會沒有效率

TOP

luke

帖子
140 
主題
37 
精華
0 
積分
193 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
註冊時間
2012-3-28 
最後登錄
2015-7-5 

2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
12#
發表於 2012-4-13 12:01 | 只看該作者
回復 11# register313


    謝謝回覆

先前朋友介紹從別的論壇就知道H超版大功力, 小弟是沒有任何懷疑

這次改變是因為原先sheet1表B欄是採物件號碼作處理, 因此測試OK

現在因資料改為物件地址採十六進位才會有比較上錯誤

以上說明

煩請大大, 先進指導, 謝謝!

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
13#
發表於 2012-4-13 15:19 | 只看該作者
回復 10# luke

用了雙層迴圈,執行效能不佳(若資料有上萬筆,我的雙核電腦跑了約20秒)
參考用
  1. Sub zz()
  2. Application.ScreenUpdating = False
  3. With sheet1
  4. .Columns("A:B").Copy .Columns("F:G")
  5. .Columns("H:I") = ""
  6. Max = sheet2.[F1].End(xlToRight).Value
  7. For Each S In .Range(.[A1], .[A1].End(xlDown))
  8.   For Each T In sheet2.Range(sheet2.[D2], sheet2.[D2].End(xlDown))
  9.     If S & S.Offset(0, 1) = T & T.Offset(0, 1) Then
  10.        If Val(S.Offset(0, 2)) <= Max And Val(S.Offset(0, 3)) <= Max Then
  11.           S.Offset(0, 7) = sheet2.Cells(T.Row, S.Offset(0, 2) + 6)
  12.           S.Offset(0, 8) = sheet2.Cells(T.Row, S.Offset(0, 3) + 6)
  13.        End If
  14.        Exit For
  15.     End If
  16.   Next
  17.   If S.Offset(0, 7) = "" Then S.Offset(0, 2).Resize(1, 2).Copy S.Offset(0, 7)
  18. Next
  19. End With
  20. Application.ScreenUpdating = True
  21. MsgBox "執行完畢"
  22. End Sub
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
14#
發表於 2012-4-13 16:20 | 只看該作者
回復 12# luke
  1. Option Explicit
  2. Sub Ex陣列()
  3.     Dim Ar1(), Ar2(), A As Range, S As Variant, xR(1 To 2)
  4.     S = 1
  5.     With sheet2
  6.         For Each A In .Range(.[D2], .[D2].End(xlDown))
  7.             ReDim Preserve Ar1(1 To S)
  8.             ReDim Preserve Ar2(1 To S)
  9.             Ar1(S) = A & A.Cells(1, 2)
  10.             Ar2(S) = .Range(A.Cells(1, 3), A.Cells(1, 2).End(xlToRight)).Value
  11.             Ar2(S) = Application.Transpose(Application.Transpose(Ar2(S)))
  12.             S = S + 1
  13.         Next
  14.     End With
  15.     With sheet1
  16.         For Each A In .Range(.[A1], .[A1].End(xlDown))
  17.             S = Application.Match(A & A(1, 2), Ar1, 0)
  18.             If Not IsError(S) Then
  19.                 xR(1) = A(1, 3)
  20.                 xR(2) = A(1, 4)
  21.                 If IsNumeric(A(1, 3)) Then If A(1, 3).Value + 1 <= UBound(Ar2(S)) Then xR(1) = Ar2(S)(A(1, 3) + 1)
  22.                 If IsNumeric(A(1, 4)) Then If A(1, 4).Value + 1 <= UBound(Ar2(S)) Then xR(2) = Ar2(S)(A(1, 4) + 1)
  23.                 A.Offset(, 5).Resize(, 4) = Array(A, A(1, 2), xR(1), xR(2))
  24.             Else
  25.                 A.Offset(, 5).Resize(, 4) = A.Resize(, 4).Value
  26.             End If
  27.         Next
  28.     End With
  29. End Sub

  31. Sub Ex字典物件()
  32.     Dim d As Object, Ar(), A As Range, C As Range, B As Range, x As String
  33.     Set d = CreateObject("Scripting.Dictionary")
  34.     With sheet2
  35.         For Each A In .Range(.[D2], .[D2].End(xlDown))
  36.             x = A & A.Cells(1, 2)
  37.             For Each C In .Range(A.Cells(1, 3), A.Cells(1, 2).End(xlToRight))
  38.                 If d.Exists(x) Then
  39.                     Ar = d(x)
  40.                     ReDim Preserve Ar(UBound(Ar) + 1)
  41.                     Ar(UBound(Ar)) = C.Value
  42.                     d(x) = Ar
  43.                 Else
  44.                     d(x) = Array(C.Value)
  45.                 End If
  46.             Next
  47.         Next
  48.     End With
  49.     With sheet1
  50.         For Each A In .Range(.[A1], .[A1].End(xlDown))
  51.             If d.Exists(A & A(1, 2)) Then
  52.                 ReDim Ar(2)
  53.                 Ar(0) = d(A & A(1, 2))
  54.                 If A(1, 3) <= UBound(Ar(0)) Then Ar(1) = Ar(0)(A(1, 3)) Else Ar(1) = A(1, 3)
  55.                 If A(1, 4) <= UBound(Ar(0)) Then Ar(2) = Ar(0)(A(1, 4)) Else Ar(2) = A(1, 4)
  56.                 A.Offset(, 5).Resize(, 4) = Array(A, A(1, 2), Ar(1), Ar(2))
  57.             Else
  58.                 A.Offset(, 5).Resize(, 4) = A.Resize(, 4).Value
  59.             End If
  60.         Next
  61.     End With
  62. End Sub
複製代碼

TOP

        靜思自在 : 要用心，不要操心、煩心。
12
返回列表 上一主題