Board logo

標題: 以註解內容加總 [打印本頁]
作者: myleoyes    時間: 2012-12-4 22:46     標題: 以註解內容加總

各位前輩你們好!
Sub Ex()
        [CR1:CR30] = ""
        [CR3] = "名稱"
        [CR4] = "常態"
        [CR5] = "額外"
        [CR6] = "特別"
        [CR7] = "補助額"
Ag:
        ZZ = Application.InputBox("選取名稱", " 請選取CR欄名稱", "補助額", Type:=8)
        If ZZ = 0 Or ZZ = "" Then GoTo Ag
        [CR2] = ZZ
        [CR1] = 71
End Sub
         問題如附檔說明
         請知道的前輩,不吝賜教謝謝再三!!
作者: GBKEE    時間: 2012-12-5 08:37

回復 1# myleoyes
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim ZZ, S, MySum As Integer, E
  4.     [CR1:CR30] = ""
  5.     [CR3] = "名稱"
  6.     [CR4] = "常態"
  7.     [CR5] = "額外"
  8.     [CR6] = "特別"
  9.     [CR7] = "補助額"
  10. Ag:
  11.     ZZ = Application.InputBox("選取名稱", " 請選取CR欄名稱", "補助額", Type:=8 + 2)
  12.     'VBA的說明: Type 可為以上允許值的和。例如，對可輸入文字和數位輸入方塊，可將 Type 設定為 1 + 2。
  13.     'Type:=8 + 2: 因直接按下InputBox時為文字 設定Type:=8 會有錯誤
  14.     If ZZ = 0 Or ZZ = "" Then GoTo Ag
  15.     [CR2] = ZZ
  16.     S = Split([M79].NoteText, Chr(10))  '註解文字轉入陣列
  17.     For Each E In S
  18.         If InStr(E, ZZ) Then MySum = MySum + Val(Mid(E, InStr(E, ZZ) + Len(ZZ)))
  19.     Next
  20.     [CR1] = MySum
  21. End Sub
複製代碼
作者: myleoyes    時間: 2012-12-5 21:13

回復 2# GBKEE
良師!謝謝!!因為小弟沒有解釋清楚
     所以程式只對一半?
     因為名稱的清單是要由程式
     依據註解內容自動建立的
     而非手動[CR4] = "常態",[CR5] = "額外"..等等
     請再麻煩教導辛苦囉謝謝再三!!
作者: Hsieh    時間: 2012-12-5 23:20

回復 3# myleoyes
  1. Sub nn()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. d("名稱") = ""
  4. With Range("M79").Comment
  5. mystr = .Text
  6. ar = Split(mystr, Chr(10))
  7. For Each a In ar
  8.    b = Split(a, " ")
  9.    x = b(0): y = b(1): z = b(2)
  10.    s = d.Count
  11.    If IsEmpty(d(y)) Then ActiveSheet.Cells(3 + s, "CR").Name = y
  12.    d(y) = d(y) + Val(z)
  13. Next
  14. End With
  15. [CR3].Resize(d.Count, 1) = Application.Transpose(d.keys)
  16. 10
  17. asw = Application.InputBox("選取名稱", " 請選取CR欄名稱", "補助額", Type:=8)
  18. If d.exists(asw) = False Then GoTo 10
  19. [CR2] = asw: [CR1] = d(asw)
  20. End Sub
複製代碼
作者: myleoyes    時間: 2012-12-6 21:15

回復 4# Hsieh
偶像前輩!偶像就是偶像果然利害謝謝再三!!



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)