afu9240

帖子: 164
主題: 45
精華: 0
積分: 211
點名: 0
作業系統: 微軟
軟體版本: win10
閱讀權限: 20
性別: 女
註冊時間: 2017-8-28
最後登錄: 2022-8-5

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2019-5-13 09:58 | 只看該作者

[發問] 請問一下函數的vba

各位高手大大們好

附件檔想請教為何無法執行,,有寫了一段vba的sumif但無法執行~求解惑謝謝

20190513.zip (12.7 KB)

樓主熱帖

yvonne

rouber590324

高中生 Rank: 3 Rank: 3

帖子: 561
主題: 160
精華: 0
積分: 725
點名: 0
作業系統: WINDOWS
軟體版本: xp
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2014-9-10
最後登錄: 2026-2-12

論壇榮譽勳章論壇贊助勳章熱烈參與勳章

2^#

發表於 2019-5-13 11:11 | 只看該作者

試試

Sub AAA()
Dim M As Long
Sheets("工作表1").Select
Range("A1").Select
Sheets("工作表1").[D2

65536].ClearContents

For M = 2 To Sheets("工作表1").[A65536].End(xlUp).Row

Sheets("工作表1").Cells(M, 4) = Application.SumIf(Sheets("工作表2").Range("B:B"), Sheets("工作表1").Cells(M, 1), Sheets("工作表2").Range("E:E"))

Next
End Sub

羅

TOP

afu9240

中學生 Rank: 2

帖子: 164
主題: 45
精華: 0
積分: 211
點名: 0
作業系統: 微軟
軟體版本: win10
閱讀權限: 20
性別: 女
註冊時間: 2017-8-28
最後登錄: 2022-8-5

3^#

發表於 2019-5-13 13:48 | 只看該作者

回復 2# rouber590324

感謝r大回覆,, R大用您的CODE套入SUMIFS也可以用, 這邊想請教要如何修改Code一次性將儲存格資料計算帶出呢~求協助~TKS
code能在簡化嗎???謝謝

0513.zip (14.69 KB)

yvonne

TOP

rouber590324

高中生 Rank: 3 Rank: 3

帖子: 561
主題: 160
精華: 0
積分: 725
點名: 0
作業系統: WINDOWS
軟體版本: xp
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2014-9-10
最後登錄: 2026-2-12

論壇榮譽勳章論壇贊助勳章熱烈參與勳章

4^#

發表於 2019-5-14 10:53 | 只看該作者

DEAR SIR
用涵數即可吧.如下 c2公式餘以此類推

=SUMPRODUCT((工作表2!$B$2

B$65536=A2)*(工作表2!$C$2

C$65536=C1),工作表2!$E$2

E$65536)

羅

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2848
主題: 10
精華: 0
積分: 2903
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2026-7-25

5^#

發表於 2019-5-15 10:32 | 只看該作者

資料不多, 可用這個:
Sub AAA()
Dim Clmn As Range
Set Clmn = [工作表2!K2].Resize([工作表2!B65536].End(xlUp).Row - 1)
Clmn = "=B2&C2"
With [工作表1!C2].Resize([工作表1!A65536].End(xlUp).Row - 1, 3)
   .Formula = "=SUMIF(工作表2!$K:$K,$A2&C$1,工作表2!$E:$E)"
   .Value = .Value
   .Replace 0, "", Lookat:=xlWhole
End With
Clmn.ClearContents
End Sub

'================================
資料很多, 用這個:
Dim xD, Arr, Brr, i&, j&, T$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([工作表2!E1], [工作表2!B65536].End(xlUp))
For i = 2 To UBound(Arr)
T = Arr(i, 1) & Arr(i, 2)
xD(T) = xD(T) + Arr(i, 4)
Next i
'----------------------------
Arr = Range([工作表1!E1], [工作表1!A65536].End(xlUp))
ReDim Brr(1 To UBound(Arr) - 1, 1 To 3)
For i = 2 To UBound(Arr)
For j = 1 To 3
T = Arr(i, 1) & Arr(1, j + 2)
Brr(i - 1, j) = xD(T)
Next j
Next i
'----------------------------
[工作表1!C2].Resize(UBound(Arr) - 1, 3).Value = Brr
End Sub

'>>>>

TOP

afu9240