返回列表 上一主題 發帖

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

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

帖子
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

帖子
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
  1. Sub Ex() 'A,B兩檔已開啟
  2.     Dim A_Rng As Range, B_Rng As Range, C_Rng As Range, i As Integer
  3.     With Workbooks("A.XLSX").Sheets(1)
  4.         Set A_Rng = .Range("i2", .[i2].End(xlDown))
  5.     End With
  6.     With Workbooks("B.XLSX").Sheets(1)
  7.         Set B_Rng = .Range("i2", .[i2].End(xlDown))
  8.     End With
  9.     With Workbooks("C.XLSX").Sheets(1)
  10.         Set C_Rng = .Range("B3", .[B3].End(xlDown))
  11.     End With
  12.     C_Rng.Offset(, 1) = ""
  13.     For i = 1 To C_Rng.Count
  14.         If i < C_Rng.Count Then
  15.             C_Rng(i, 2) = Application.CountIf(A_Rng, C_Rng(i)) + Application.CountIf(B_Rng, C_Rng(i))
  16.         Else
  17.             C_Rng(i, 2) = A_Rng.Count + B_Rng.Count - Application.Sum(C_Rng.Offset(, 1))
  18.         End If
  19.     Next
  20.     Set A_Rng = Nothing
  21.     Set B_Rng = Nothing
  22.     Set C_Rng = Nothing
  23. End Sub
複製代碼

TOP

zaq370

帖子
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

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言，就如鑽石般珍貴；但對愚人來說，卻像是一把泥土，一點價值也沒有。
返回列表 上一主題