返回列表 上一主題 發帖

[發問] Excel VBA有什麼現有的函數可以用來找尋二維陣列中的資料？

newstarmoon

帖子
5 
主題
1 
精華
0 
積分
55 
點名
0  
作業系統
Win 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
屏東 
註冊時間
2018-1-15 
最後登錄
2020-7-16 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2018-5-29 02:01 | 只看該作者

[發問] Excel VBA有什麼現有的函數可以用來找尋二維陣列中的資料？

各位前輩好，我剛用Excel  VBA寫巨集沒多久，目前我會將工作表中的資料，先讀到陣列後再做運算(這樣執行速度較快)

平常查某個值有沒有在陣列中很好比對，但最近遇到一個狀況，就是我要查A值(例如身份證號)有沒有在B陣列中，但B陣列中，每個行列值，並不單純是身份證號，而且一長串的文字(可能有十幾個字，而其中包含了身份證號)，

有什麼現有的函數或方法可以用來比對A值有沒有在B陣列中？  ~~新手提問，煩請大家指教~~謝謝~~
收藏 分享
冬冬

newstarmoon

帖子
5 
主題
1 
精華
0 
積分
55 
點名
0  
作業系統
Win 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
屏東 
註冊時間
2018-1-15 
最後登錄
2020-7-16 
2#
發表於 2018-6-2 17:53 | 只看該作者
這Excel檔裡有3個工作表，工作表中的藥代欄是主要資料，我要從藥材檔的資料中，比對藥代是否一樣，目前已經可以比對藥代、健保碼、藥名是否相同；但藥材檔中的"DK"列，有這藥品的歷史修改資料，我想用健保碼跟DK列比對，看DK列中是否有相同的健保碼，不知道有什麼方法可以使用？

針劑醫令代碼比對-test.zip (38.57 KB)

冬冬

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 2018-6-5 09:24 | 只看該作者
本帖最後由 GBKEE 於 2018-6-11 14:09 編輯

回復 2# newstarmoon
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim AR(), Ar1(), Ar2(), i As Long, ii As Long, iii As Long, Msg As String
  4.     Dim xRow As Integer
  5.     Ar1 = Array("a", "b", "d") '你的C欄隱藏了
  6.     ReDim AR(1 To UBound(Ar1) + 1)
  7.     Sheets("運算").UsedRange.Clear
  8.     With Sheets("工作表")
  9.         For i = 1 To UBound(Ar1) + 1
  10.             ii = IIf(.Cells(Rows.Count, Ar1(i - 1)).End(xlUp).Row > ii, .Cells(Rows.Count, Ar1(i - 1)).End(xlUp).Row, ii)
  11.             '如果某一列的資料有100行，而第5行是空白
  12.             '***必須找出所有欄位中最後資料有的列號 ***
  13.         Next
  14.         For i = 1 To UBound(Ar1) + 1
  15.             AR(i) = Application.WorksheetFunction.Transpose(.Range(Ar1(i - 1) & "1").Resize(ii).Value)
  16.         Next
  17.     End With
  18.     With Sheets("藥材檔")
  19.         Ar1 = .Range(.[A5], .[A5].End(xlDown)).Resize(, 5).Value
  20.         For i = 1 To .[A5].End(xlDown).Row - 4
  21.             Ar1(i, 5) = .Range("DK" & i + 4) '**加入"DK"欄
  22.         Next
  23.     End With
  24.     For i = 2 To UBound(AR(1)) '藥代
  25.         '**************************
  26.         '"工作表"
  27.         'AR(1)(i)=>藥代    AR(2)(i)=>藥單名    AR(3)(i)=>健保碼
  28.         '**************************
  29.         '"藥材檔"
  30.         'Ar1(ii, 1)=>藥代    Ar1(ii, 2)=>代號    Ar1(ii, 3)=>健保碼  Ar1(ii, 4)=>藥名
  31.         'Ar1(ii, 5)=>DK
  32.         '**************************
  33.         
  34.         Msg = ""
  35.         For ii = 1 To UBound(Ar1)
  36.             If AR(1)(i) <> "" And Ar1(ii, 1) <> AR(1)(i) Then    '藥代不相同
  37.                 'InStr(Ar1(ii, 5), (AR(3)(i))) ->查看有無相同健保碼
  38.                 If UCase(Ar1(ii, 4)) = UCase(AR(2)(i)) Or UCase(Ar1(ii, 3)) = UCase(AR(3)(i)) Or InStr(Ar1(ii, 5), (AR(3)(i))) Then
  39.                     Msg = Msg & IIf(Msg <> "", ",", "") & ii  '比對到帶入
  40.                 End If
  41.             End If
  42.         Next
  43.         If Msg <> "" Then
  44.             With Sheets("運算").Cells(Rows.Count, "A").End(xlUp)
  45.               xRow = IIf(.Row = 1, 0, 2)
  46.                 Ar2 = Application.Index(Application.WorksheetFunction.Transpose(AR), 1)
  47.                 .Offset(xRow).Resize(, UBound(Ar2)) = Ar2
  48.                 Ar2 = Application.Index(Application.WorksheetFunction.Transpose(AR), i)
  49.                 .Offset(xRow + 1).Resize(, UBound(Ar2)) = Ar2
  50.                 Ar2 = Array("藥代", "代號", "健保碼", "藥名", "DK欄")
  51.                 .Offset(xRow + 2).Resize(, UBound(Ar2) + 1) = Ar2
  52.             End With
  53.             With Sheets("運算").Cells(Rows.Count, "A").End(xlUp).Offset(1)
  54.                For iii = 0 To UBound(Split(Msg, ","))
  55.                 Ar2 = Application.Index(Ar1, Split(Msg, ",")(iii))
  56.                .Offset(iii).Resize(, UBound(Ar2)) = Ar2
  57.                Next
  58.             End With
  59.         End If
  60.     Next
  61. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

newstarmoon

帖子
5 
主題
1 
精華
0 
積分
55 
點名
0  
作業系統
Win 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
屏東 
註冊時間
2018-1-15 
最後登錄
2020-7-16 
4#
發表於 2018-6-11 00:21 | 只看該作者
謝謝版主的回復，因為我只有六日比較有空，所以這一兩天才花時間好好理解版主的程式碼；
仔細研究完後，版主的程式碼讓我受益良多，也學到了許多概念。
像你用的"InStr"函數，就是我提問中，最需要的函數，我會好好運用它；你另外有用了"Split"函數，我有去查了Split函數的用法，這函數功能真的很不錯，我會仔細記下來。

另外再請教版主一個問題，你程式碼中"AR(i) = Application.WorksheetFunction.Transpose(.Range(Ar1(i - 1) & ":" & Ar1(i - 1)).SpecialCells(xlCellTypeConstants).Value)"這一段，如果某一列的資料有100行，而第5行是空白，後面接著有資料，但這一段程式，它讀到第5行是空白後就結束不會再讀下去，這有沒有什麼方法可以改良？

謝謝版主的細心回覆~~
冬冬

TOP

newstarmoon

帖子
5 
主題
1 
精華
0 
積分
55 
點名
0  
作業系統
Win 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
屏東 
註冊時間
2018-1-15 
最後登錄
2020-7-16 
5#
發表於 2018-7-5 10:38 | 只看該作者
版主你好，我最近有碰到一個小問題要再請教你一下

For i = 1 To UBound(Ar1) + 1
            AR(i) = Application.WorksheetFunction.Transpose(.Range(Ar1(i - 1) & "1").Resize(ii).Value)

上面這段程式碼，平常在用的時候都ok，但我最近遇到我的資料行數超過6萬多行時，這一段程式碼就會出錯，不知道是不是Transpose有什麼限制，或者有什麼方法可以改善？

謝謝版主~~
冬冬

TOP

        靜思自在 : 一個缺口的杯子，如果換一個角度看它，它仍然是圓的。
返回列表 上一主題