faye59

回復 1# prince0413


   
這樣?

1. Private Sub CommandButton1_Click()
   
2. Application.ScreenUpdating = False
   
3. [N2:O10000] = ""
   
4. For Each aa In Range([B2], [B2].End(xlDown))
   
5. For i = 1 To Application.CountA(Range("N:N"))
   
6. If aa = Cells(i, 14) Then
   
7. Cells(i, 15) = Cells(i, 15) + aa.Offset(, 7)
   
8. ElseIf Cells(i + 1, 14) = "" Then
   
9. Cells(i + 1, 14) = aa.Offset(, 0)
   
10. Cells(i + 1, 15) = aa.Offset(, 7)
    
11. End If
    
12. Next
    
13. Next
    
14. End Sub

複製代碼

faye59

回復 5# prince0413


   
我寫得好像沒有上限值(至少能到65536筆)
這段程式碼沒有很活
所以有如人名Key錯、欄位不對、切換頁不對...等都可能造成程序錯誤
需要修正再給多點資訊及可增加

1. Private Sub CommandButton1_Click()'開始按鈕程式
   
2. Application.ScreenUpdating = False'關閉刷頻
   
3. [N2:O10000] = ""'清除範圍資料
   
4. For Each aa In Range([B2], [B2].End(xlDown))'迴圈人員名單
   
5. For i = 1 To Application.CountA(Range("N:N"))'迴圈統計業績總點數
   
6. If aa = Cells(i, 14) Then'當名子重覆時執行
   
7. Cells(i, 15) = Cells(i, 15) + aa.Offset(, 7)'名子欄位往右一格填入For Each取得的點數，並加總
   
8. ElseIf Cells(i + 1, 14) = "" Then'當名子不重覆時後一筆資料為空白時執行
   
9. Cells(i + 1, 14) = aa.Offset(, 0)'新建立名子
   
10. Cells(i + 1, 15) = aa.Offset(, 7)'新建立該員點數
    
11. End If'結束如果
    
12. Next'下一個For i迴圈
    
13. Next'下一個For Each迴圈
    
14. End Sub'結束程式

複製代碼

faye59

回復 5# prince0413


    還有程序中只有寫當前Sheet的資料統計，
沒有區分月份，
如果要月份需要再加入A欄位的判讀，
否則你當前Sheet就放入當月份就好。
(當時簡易寫寫而已，沒想太多)

如果需要修改再提出問題，
一次幫你做修正。