12
返回列表 上一主題 發帖

[發問] 如何用迴圈，將ADD_M欄中有含字母併計

s7659109

帖子
248 
主題
76 
精華
0 
積分
331 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
性別
男 
來自
kaohsiung 
註冊時間
2013-6-10 
最後登錄
2020-7-3 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-10-12 16:12 | 只看該作者

[發問] 如何用迴圈，將ADD_M欄中有含字母併計

請問，迴圈中，判斷式，可加入字母嗎？

問題51.rar (271.19 KB)

收藏 分享
希望支持!

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2016-10-19 12:26 | 只看該作者
回復 1# s7659109
問題：如何用迴圈，將ADD_M欄中有含字母併計
如何合併 請再說詳細

你想要的是這樣嗎?
  1. ub Ex()
  2.     With Range(Cells(2, "C"), Cells(2, "C").End(xlDown))
  3.         .NumberFormatLocal = "G/通用格式"  '附檔的格式是文字
  4.         .Cells = .Value
  5.         .Offset(, 2).FormulaR1C1 = "=IF(ISNUMBER(RC[-2]),0,1)"
  6.         MsgBox "M欄中有含字母 共有 " & Application.Sum(.Offset(, 2))
  7.         '********************
  8.         '.Offset(, 2).FormulaR1C1 = "=ISNUMBER(RC[-2])"
  9.        'MsgBox "M欄中有含字母 共有 " &  Application.CountIf(.Offset(, 2), False)
  10.        .Offset(, 2) = ""
  11.     End With
  12. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

s7659109

帖子
248 
主題
76 
精華
0 
積分
331 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
性別
男 
來自
kaohsiung 
註冊時間
2013-6-10 
最後登錄
2020-7-3 
3#
發表於 2016-10-20 13:42 | 只看該作者
版主你誤會我的意思，我的問題是用迴圈統計結果1與結果2，並列出明細，附件重新上傳了。

問題51.rar (260.66 KB)

希望支持!

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2016-10-21 05:44 | 只看該作者
回復 3# s7659109

問題要說清楚,才有人會回覆.
結果1 包含有"Y" 的資料,但為不包含有"Y"的只有183一筆
結果2 包含有"G" 的資料,但為不包含有"G"的有一大堆資料
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

s7659109

帖子
248 
主題
76 
精華
0 
積分
331 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
性別
男 
來自
kaohsiung 
註冊時間
2013-6-10 
最後登錄
2020-7-3 
5#
發表於 2016-10-21 08:50 | 只看該作者
本帖最後由 s7659109 於 2016-10-21 08:52 編輯

版主：我是一個VBA初學者，謝謝你的提醒
我的問題：是利用迴圈將原始資料(左側_我有加大資料，請考慮每天都會新增資料，自動更新),求出
結果1:是將ADD欄中A001 且ADD_M中001~199區間(包含有字母一併計入，如1Y1,1A5,07Z等等)累計，並列出明細
結果2:是將ADD欄中A001 且ADD_M中200~999區間(包含有字母一併計入，如2G0,,28J等等)累計，並列出明細

問題51_.rar (244.07 KB)

希望支持!

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2016-10-21 13:11 | 只看該作者
回復 5# s7659109
用進階篩選試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng(1 To 3) As Range
  4.     Set Rng(1) = Range("B:D").SpecialCells(xlCellTypeConstants)    '**資料庫
  5.     Set Rng(2) = Cells(1, Columns.Count).Resize(2)                          '**資料庫的準則範圍,CriteriaRange
  6.     Set Rng(3) = Range("G2,K2")                                                       '**資料庫的準則範圍,CopyToRange
  7.     Rng(3)(1).CurrentRegion.Clear
  8.     Rng(3).Areas(2).CurrentRegion.Clear
  9.     '** 資料庫的準則為 "計算式準則",準則欄位名稱不可與 資料庫的欄位名稱相同 ****
  10.     Rng(2).Cells(1) = "TEST"                                                              '資料庫的準則欄位名稱
  11.     Rng(2).Cells(2) = "=VALUE(MID(ADD_M,1,1))<2"                    ''篩選資料庫的準則 , 計算式準則
  12.     '**MID(ADD_M,1,1) -> 資料庫欄位  "ADD_M" 的第一個字串"
  13.     '**=VALUE(MID(ADD_M,1,1))<2 第一個字串小於2
  14.      Rng(1).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Rng(2), CopyToRange:=Rng(3).Cells(1), Unique:=False
  15.      Rng(3).Cells(0) = "小計"
  16.      Rng(3).Cells(0, 3) = Application.Sum(Rng(3).Cells(0, 3).EntireColumn)     
  17.      Rng(2).Cells(2) = "=VALUE(MID(ADD_M,1,1))>=2"
  18.      '**=VALUE(MID(ADD_M,1,1))<2 第一個字串大於等於2
  19.      Rng(1).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Rng(2), CopyToRange:=Rng(3).Areas(2), Unique:=False
  20.      Rng(3).Areas(2).Cells(0) = "小計"
  21.      Rng(3).Areas(2).Cells(0, 3) = Application.Sum(Rng(3).Areas(2).Cells(0, 3).EntireColumn)
  22.     Rng(2).Clear
  23. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

s7659109

帖子
248 
主題
76 
精華
0 
積分
331 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
性別
男 
來自
kaohsiung 
註冊時間
2013-6-10 
最後登錄
2020-7-3 
7#
發表於 2016-10-21 13:56 | 只看該作者
本帖最後由 s7659109 於 2016-10-21 13:58 編輯

版主：
謝謝版主解惑，但結果1與2中ADD欄，只要A001,其它的不列入，故
TOTAL與明細有誤。

問題51_2.rar (368.06 KB)

希望支持!

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
8#
發表於 2016-10-21 16:53 | 只看該作者
題意不清, 就無法回應!!!
  1. Sub TEST()
  2. Dim T$, Arr, Brr, Crr, Bn&, Cn&, Sb, Sc, i&, j%
  3. [G3:I6000,K3:M6000].ClearContents:  [I1,M1] = ""
  4. If [G1] = "" Then Exit Sub
  5. Arr = Range("B2:D" & Cells(Rows.Count, 2).End(xlUp).Row)
  6. ReDim Brr(1 To UBound(Arr), 1 To 3): Crr = Brr
  7. For i = 1 To UBound(Arr)
  8.     If Arr(i, 1) <> [G1] Then GoTo 101
  9.     If Left(Arr(i, 2), 1) Like "[0-1]" Then
  10.        Bn = Bn + 1: Sb = Sb + Val(Arr(i, 3))
  11.        For j = 1 To 3: Brr(Bn, j) = Arr(i, j): Next
  12.     ElseIf Left(Arr(i, 2), 1) Like "[2-9]" Then
  13.        Cn = Cn + 1: Sc = Sc + Val(Arr(i, 3))
  14.        For j = 1 To 3: Crr(Cn, j) = Arr(i, j): Next
  15.     End If
  16. 101: Next i
  17. If Bn > 0 Then [G3:I3].Resize(Bn) = Brr: [I1] = Sb
  18. If Cn > 0 Then [K3:M3].Resize(Cn) = Crr: [M1] = Sc
  19. End Sub
複製代碼
Xl0000193.rar (20.08 KB)

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 2016-10-23 11:06 | 只看該作者
回復 7# s7659109
擴大資料庫的準則範圍為二欄
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng(1 To 3) As Range
  4.     Set Rng(1) = Range("B:D").SpecialCells(xlCellTypeConstants)    '**資料庫
  5.     Set Rng(2) = Cells(1, Columns.Count - 1).Resize(2, 2)                       '**資料庫的準則範圍,CriteriaRange
  6.     Set Rng(3) = Range("G2,K2")                                                       '**資料庫的準則範圍,CopyToRange
  7.     Rng(3)(1).CurrentRegion.Clear
  8.     Rng(3).Areas(2).CurrentRegion.Clear
  9.     '** 資料庫的準則為 "計算式準則",準則欄位名稱不可與 資料庫的欄位名稱相同 ****
  10.    
  11.     Rng(2).Cells(1, 1) = "TEST"                                                             '資料庫的準則欄位名稱
  12.     Rng(2).Cells(2, 1) = "=VALUE(MID(ADD_M,1,1))<2"                   ''篩選資料庫的準則 , 計算式準則
  13.     Rng(2).Cells(1, 2) = "ADD"                                                             '資料庫的準則欄位名稱
  14.     Rng(2).Cells(2, 2) = "A001"                                                           ''篩選資料庫的準則
  15.    
  16.     '**MID(ADD_M,1,1) -> 資料庫欄位  "ADD_M" 的第一個字串"
  17.     '**=VALUE(MID(ADD_M,1,1))<2 第一個字串小於2
  18.      Rng(1).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Rng(2), CopyToRange:=Rng(3).Cells(1), Unique:=False
  19.      Rng(3).Cells(0) = "小計"
  20.      Rng(3).Cells(0, 3) = Application.Sum(Rng(3).Cells(0, 3).EntireColumn)
  21.      Rng(2).Cells(2, 1) = "=VALUE(MID(ADD_M,1,1))>=2"
  22.      '**=VALUE(MID(ADD_M,1,1))<2 第一個字串大於等於2
  23.      Rng(1).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Rng(2), CopyToRange:=Rng(3).Areas(2), Unique:=False
  24.      Rng(3).Areas(2).Cells(0) = "小計"
  25.      Rng(3).Areas(2).Cells(0, 3) = Application.Sum(Rng(3).Areas(2).Cells(0, 3).EntireColumn)
  26.     Rng(2).Clear
  27. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

s7659109

帖子
248 
主題
76 
精華
0 
積分
331 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
性別
男 
來自
kaohsiung 
註冊時間
2013-6-10 
最後登錄
2020-7-3 
10#
發表於 2016-10-26 10:02 | 只看該作者

如何用迴圈，將ADD_M欄中有含字母併計(進階需求版)

大大：
問題：根據輸入條件，輸出明細二張表與彙計，其中日期要轉換，有固定列在第一列之條件，還有特殊條件需求

問題52.rar (17.25 KB)

希望支持!

TOP

        靜思自在 : 脾氣嘴巴不好，心地再好也不能算是好人。
12
返回列表 上一主題