zaq370

帖子: 13
主題: 3
精華: 0
積分: 22
點名: 0
作業系統: WIN 7
軟體版本: office 2010
閱讀權限: 10
性別: 男
註冊時間: 2011-8-25
最後登錄: 2011-9-15

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2011-9-1 15:29 | 只看該作者

請問資料合併計算總和要如何寫?

檔案如附檔

說明：
比如c檔案的總和欄位要去計算a和b檔案的資料中儲存格總數，但a檔案中的"d"和"e"資料直接與b檔案中的"f"資料一起計算成"f"資料的總和，這個巨集要如何寫？

My Documents.rar (16.76 KB)

樓主熱帖

dechiuan999

中學生 Rank: 2

帖子: 231
主題: 55
精華: 0
積分: 293
點名: 0
作業系統: winxp
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: KEELUNG
註冊時間: 2010-7-24
最後登錄: 2018-8-28

2^#

發表於 2011-9-1 18:41 | 只看該作者

你好
請試試如下
Sub aa()

'請先由工具設定Microsoft Scripting Rungtime

Dim mSht As Worksheet
Dim mDic As Scripting.Dictionary
Dim mKey, mItem
Dim mArr
Dim mRng As Range, E As Range
Dim s%, s1%

Set mDic = CreateObject("scripting.dictionary")
mArr = Array("a", "b")

For i = 0 To 1
      With Workbooks.Open(ThisWorkbook.Path & "\" & mArr(i) & ".xlsx")
         With .Sheets(1)
            Set mRng = .Range("i2:i" & .[i65536].End(xlUp).Row)
         End With

            For Each E In mRng
                  If mDic.Exists(E.Value) = False Then
                     mDic(E.Value) = 1
                  Else
                     mDic(E.Value) = mDic(E.Value) + 1
                  End If

            Next

            mKey = mDic.Keys
            mItem = mDic.Items

         .Close
      End With
Next

For i = 0 To mDic.Count - 1
      If mKey(i) = "d" Then
         s = mItem(i)
      End If

      If mKey(i) = "e" Then
         s1 = mItem(i)
      End If

Next

For i = 0 To mDic.Count - 1

      If mKey(i) = "f" Then
         mItem(i) = mItem(i) + s + s1
      End If
Next

'Set mRng = Range("b3:b" & [b65536].End(xlUp).Row)    '
'
'For Each E In mRng                   '版主大大是否可幫小弟解惑為何此語法無法正確取出dictionary的items值呢？
' E.Offset(, 1) = mDic(E.Value)    '此部份有問題
'Next

For i = 0 To mDic.Count - 1
      Set mRng = Columns("b").Find(mKey(i), lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
      If Not mRng Is Nothing Then
         mRng.Offset(, 1) = mItem(i)
      End If

Next

End Sub

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

3^#

發表於 2011-9-1 20:33 | 只看該作者

回復 1# zaq370

Sub Ex() 'A,B兩檔已開啟
Dim A_Rng As Range, B_Rng As Range, C_Rng As Range, i As Integer
With Workbooks("A.XLSX").Sheets(1)
Set A_Rng = .Range("i2", .[i2].End(xlDown))
End With
With Workbooks("B.XLSX").Sheets(1)
Set B_Rng = .Range("i2", .[i2].End(xlDown))
End With
With Workbooks("C.XLSX").Sheets(1)
Set C_Rng = .Range("B3", .[B3].End(xlDown))
End With
C_Rng.Offset(, 1) = ""
For i = 1 To C_Rng.Count
If i < C_Rng.Count Then
C_Rng(i, 2) = Application.CountIf(A_Rng, C_Rng(i)) + Application.CountIf(B_Rng, C_Rng(i))
Else
C_Rng(i, 2) = A_Rng.Count + B_Rng.Count - Application.Sum(C_Rng.Offset(, 1))
End If
Next
Set A_Rng = Nothing
Set B_Rng = Nothing
Set C_Rng = Nothing
End Sub

複製代碼

TOP

zaq370

小學生 Rank: 1

帖子: 13
主題: 3
精華: 0
積分: 22
點名: 0
作業系統: WIN 7
軟體版本: office 2010
閱讀權限: 10
性別: 男
註冊時間: 2011-8-25
最後登錄: 2011-9-15

4^#

發表於 2011-9-2 11:52 | 只看該作者

回復 3# GBKEE

感謝大大的幫忙，問題已解決了！！

TOP