返回列表 上一主題 發帖

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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 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

        靜思自在 : 人要知福、惜福、再造福。
返回列表 上一主題