- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
4#
發表於 2011-3-2 09:54
| 只看該作者
回復 3# ivan731129
03版- Sub Ex()
- Dim D(1 To 2) As Object, R, SH As Worksheet, T As String, I As Integer, AR(), A
- Dim ShCount As Integer
- Set D(1) = CreateObject("SCRIPTING.DICTIONARY")
- Set D(2) = CreateObject("SCRIPTING.DICTIONARY")
- With Sheets("集合檔")
- .Cells.Clear
- For Each SH In Sheets
- If SH.Name = "集合檔" Then Exit For
- ShCount = ShCount + 1
- For Each R In SH.Range("A1").CurrentRegion.Rows
- T = R.Cells(1) & "," & Join(Application.Transpose(Application.Transpose(R.Cells(1, 1).Resize(1, 8))), ",")
- If D(1).Exists((T)) = False Then
- D(1)(T) = Array(False, 1)
- D(2)(T) = Array(Join(Application.Transpose(Application.Transpose(R)), ","))
- Else
- D(1)(T) = Array(True, D(1)(T)(1) + 1)
- If R.Row <> 1 Then
- AR = D(2)(T)
- ReDim Preserve AR(UBound(AR) + 1)
- AR(UBound(AR)) = Join(Application.Transpose(Application.Transpose(R)), ",")
- D(2)(T) = AR
- End If
- End If
- Next
- Next
- For Each R In D(1).KEYS
- If D(1)(R)(0) = True And D(1)(R)(1) = ShCount Then 'D(1)(R)(1) = ShCount 每個資料庫都出現
- For Each A In D(2)(R)
- I = I + 1
- .Cells(I, 1).Resize(1, UBound(Split(A, ",")) + 1) = Split(A, ",")
- Next
- End If
- Next
- End With
- End Sub
|
|
發表於 2011-3-1 17:18
| 
