Board logo

標題: 合計註解內容 [打印本頁]
作者: myleoyes    時間: 2013-9-15 17:04     標題: 合計註解內容

各位前輩你們好!!   
         問題如附檔說明
         請知道的前輩,不吝賜教謝謝再三!!
作者: GBKEE    時間: 2013-9-15 21:04

回復 1# myleoyes
  1. Sub 總計()
  2.     Dim S As Variant, E As Variant, A As Long
  3.     S = Split([g2].NoteText, vbLf)
  4.     For Each E In S
  5.         E = Replace(Replace(E, "增資", ","), "匯率", ",")
  6.         A = A + Val(Split(E, ",")(1)) * Val(Split(E, ",")(2))
  7.     Next
  8.     [g2] = A
  9.     Application.OnTime Now + TimeValue("00:00:03"), "恢復"
  10. End Sub
複製代碼
作者: myleoyes    時間: 2013-9-16 22:56

回復 2# GBKEE
良師!謝謝再三!!
        再麻煩這個附檔可能比較複雜些
       請耐心看看辛苦囉!謝謝再三!!
作者: GBKEE    時間: 2013-9-17 06:35

回復 3# myleoyes
  1. Sub 分析()
  2.     Dim ZZ As Integer, E As Range
  3.     ZZ = Application.InputBox("輸入數字", "        請輸入數據", Type:=1)  '數字的Type:=1
  4.     If ZZ = 0 Then Exit Sub
  5.     For Each E In Selection   '檢查 選擇範圍 是否在"E欗" 且 不為空白的儲存格
  6.         If Mid(E.Address(0, 0), 1, 1) <> "E" Or E = "" Then Exit Sub
  7.     Next
  8.     Range("AN3:AN" & Range("E3").End(xlDown).Row) = ""
  9.     [G1] = Application.Sum(Selection.Offset(, 2))
  10.     Selection.Offset(, 35) = ZZ
  11.     [M1] = Application.Sum(Selection.Offset(, 8))
  12. End Sub
複製代碼
作者: myleoyes    時間: 2013-9-17 22:31

回復 4# GBKEE
良師!謝謝再三!!
     程式在取消話框輸入數字時有誤
     小弟修改如附檔說明
     至於'數字的Type:=1故意改為Type:=2
     方便兩手並用所以當If ZZ <= 0 Or ZZ = "" Then
     [G1] = Evaluate("=SUMIF($E$3:$E$400," & Selection.Address & ",$G$3:$G$400)")
     [M1] = Evaluate("=SUMIF($E$3:$E$300," & Selection.Address & ",$M$3:$M$400)")
     不好意思再麻煩這個附檔
     辛苦囉!謝謝再三!!
作者: GBKEE    時間: 2013-9-18 08:45

本帖最後由 GBKEE 於 2013-9-18 08:53 編輯

回復 5# myleoyes
5# 附檔與 5#的內容(修改後可行就好),沒有關聯
  1. Sub 增資註解(註解 As String)
  2.     Dim S(), AR(), E As Variant, i As Integer, M As Variant
  3.     With Range("G2")
  4.         .NoteText .NoteText & IIf(.NoteText <> "", Chr(10), "") & 註解
  5.         i = 1
  6.         For Each E In Split(.NoteText, vbLf)
  7.              If E <> "" Then
  8.                  ReDim Preserve S(1 To i)
  9.                  S(i) = E
  10.                  ReDim Preserve AR(1 To i)
  11.                 AR(i) = CDbl(CDate(Split(E, "增資")(0)))
  12.                 i = i + 1
  13.             End If
  14.         Next
  15.         For i = 1 To UBound(AR)
  16.           M = Application.Large(AR, i)
  17.           M = Application.Match(M, AR, 0)
  18.             If i = 1 Then
  19.                 .NoteText ""
  20.                 .NoteText S(M)
  21.             Else
  22.                 .NoteText .NoteText & vbLf & S(M)
  23.             End If
  24.         Next
  25.         '.NoteText .NoteText & IIf(.NoteText <> "", Chr(10), "") & 註解
  26.         .Comment.Shape.TextFrame.AutoSize = True
  27.     End With
  28. End Sub
複製代碼
作者: myleoyes    時間: 2013-9-18 21:27

回復 6# GBKEE
良師!辛苦你囉不勝感激謝謝再三!!
     小弟在此順祝你與家人
     中秋節快樂....事事如意
     同時也祝福各位版主與各位前輩們!
     中秋節快樂....美夢成真!!



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