- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
18#
發表於 2015-9-3 14:43
| 只看該作者
回復 17# EGBT
試試看 你的附檔程式碼- Option Explicit
- Sub Ex()
- Dim 數值表 As Variant, 陣列表 As Variant, E As Variant, EE As Variant
- Dim Ar(), Ar1(1 To 2), Ar2(), i As Integer, M As Variant
- '假設x1為1~n個sheet (但不知道有幾個sheet),由下面程式碼取得
- For Each E In Sheets
- If E.Name Like "數值*" Then 數值表 = 數值表 & "," & E.Name '字串:集合數值表
- If E.Name Like "陣列*" Then 陣列表 = 陣列表 & "," & E.Name '字串:集合陣列表
- Next
- '*******************************************
- 數值表 = Split(Mid(數值表, 2), ",") '陣列: 字串以","分割為陣列
- 陣列表 = Split(Mid(陣列表, 2), ",")
- ReDim Ar2(0) '重置陣列
- For Each E In Sheets(數值表) '工作表陣列(數值表)
- '每一數值表
- Ar = E.Range("A:A").SpecialCells(xlCellTypeConstants).Value '數值資料置入陣列
- Ar = Application.WorksheetFunction.Transpose(Ar) '陣列:二維(橫)轉一維(直)
- For Each EE In Sheets(陣列表) '工作表陣列(陣列表)
- '每一陣列表
- For i = 1 To UBound(Ar) '數值資料陣列
- M = Application.Match(Ar(i), EE.Range("A:A"), 0) '每一陣列表中Match數值
- Ar1(1) = E.Name & " -" & Ar(i)
- If IsError(M) Then
- Ar1(2) = EE.Name & " - 找不到"
- Else
- Ar1(2) = EE.Name & " -A" & M
- End If
- Ar2(UBound(Ar2)) = Ar1
- ReDim Preserve Ar2(UBound(Ar2) + 1) '陣列重置元素索引值,Preserve(保留原有元素)
- Next
- Next
- Next
- ReDim Preserve Ar2(UBound(Ar2) - 1) '陣列轉置時如子元素有為陣列,其他子元素須為相同大小的陣列
- Sheets("結果").Range("A1").Resize(UBound(Ar2) - 1, 2) = Application.Transpose(Application.Transpose(Ar2))
- End Sub
|
|
發表於 2015-9-2 14:43
| 
