合計註解內容

myleoyes

各位前輩你們好!!   
         問題如附檔說明
         請知道的前輩,不吝賜教謝謝再三!!

GBKEE

回復 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

回復 2# GBKEE
良師!謝謝再三!!
        再麻煩這個附檔可能比較複雜些
       請耐心看看辛苦囉!謝謝再三!!

GBKEE

回復 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

回復 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

回復 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

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