sillykin

回復 25# GBKEE

大大不好意思..在打擾一下

    營業單位應為
萬里分部、 金山分部、石門分部、三之分部、義山分部、水碓分部、營業部、英專分部、竹圍分部、龍形分部、八里分部、板橋分 部、桃園分部、代理部、出納部、業務部、理財部管理分部應為
審查部、法務部、會計部、總務部、行政部、信用部、企劃部、教育部、人事部

管理部有在vba
但營業單位沒有進到vba????

GBKEE

回復 27# sillykin
不在 管理部門的職稱會是在"營業部門"的
   

1. Const 管理部門 = "審查部、法務部、會計部、總務部、行政部、信用部、企劃部、教育部、人事部"
   
2. 部門 = IIf(InStr(管理部門, 單位), "管理部門", "營業部門")               'InStr傳回  0->沒找到="營業部門"

複製代碼

為何會沒有vba會找不到"營業部門"  請上傳檔案 程式碼看看

sillykin

依回覆22檔案
如果條件欄位不動..
但隨時可去條件欄位更動
責任額、達成額計算標準、幹部、非幹部獎懲標準表
是否可行呢???
因為直接去VBA去更動有點冒險，直接在條件儲存格去更動數字，比較不會犯錯．


板主不好意思．．幾日來製造你很多問題．身感抱歉

sillykin

回復 30# sillykin


    Option Explicit
Const 管理部門 = "審查室、法務室、會計室、總務室、行政管理室、徵信室、企劃室、教育發展室、資訊室"
Const 職務別 = "0,副總經理,協理,高級專員,經理,權理經理,副經理,副理,一等襄理,二等襄理,業務專員,辦事員,助理員,雇員,服務生"
Sub Ex()
    Dim I As Integer
    With Sheets("＆＆單位成績總表＆＆").Range("A3")
        Do While .Offset(I) <> ""
            獎金程式 .Offset(I), .Offset(I, 2), .Offset(I, 4)
            I = I + 1
        Loop
    End With
End Sub

Private Sub 獎金程式(單位 As Range, 職稱 As String, 達成額 As Integer)
    '  ****(條件工作表中) 沒有的職稱 ->  高級專員, 權理經理  ***
    Dim Ar, 責任額 As Integer, 達成百分比 As Single, 獎金 As Integer, 副總獎金 As Integer
    Dim 部門 As String, 職稱代號 As String, M As Integer '
    'LTrim、RTrim 與 Trim 函數  傳回一個沒有前頭空白 (LTrim)、後面空白 (RTrim)或前後均無空白的Variant (String)，其中所含為給定的字串。*
    職稱代號 = Trim(單位.Offset(, 2))                                                   '傳回職稱代號前後均無空白的Variant (String)
    'Split 函數 傳回一個陳列索引從零開始的一維陣列，它包含指定數目的子字串。
    單位.Offset(, 7) = Application.Match(職稱代號, Split(職務別, ","), 0)               'Match 職稱代號在職務別以Split分割出的陣列中的位置
    'InStr 函數 傳回在某字串中一字串的最先出現位置，此位置為 Variant (Long)。
    部門 = IIf(InStr(管理部門, 單位), "管理部門", "營業部門")               'InStr傳回0->沒找到="營業部門"
    副總獎金 = 0                                                        '預設為副總獎金為 0
    責任額 = IIf(部門 = "管理部門", 300, 500)
    If 部門 = "營業部門" Then
        Ar = Array(0, 0, -10000, -7000, -5000, -4000, -3000, -2000, -1000, -500, 800, 75)           '非幹部(獎懲獎金)
        If 單位.Offset(, 7) <= 10 Then
            Ar = Array(0, 0, -25000, -20000, -16000, -12000, -8000, -6000, -4000, -2000, 2000, 155) '幹部  (獎懲獎金)
            M = Application.Match(職稱代號, Array("高級專員", "二等襄理", "一等襄理", "副經理", "協理", "經理", "副總經理"), 0)
            'M = > Match 的數字
            責任額 = Application.Index(Array(500, 1500, 2000, 2200, "(註1)", "(註1)", 2500), M)  '責任額 陣列(高級專員->100)
            'Index 傳回一個表格或範圍內的某個值或參照位址。
            副總獎金 = IIf(職稱代號 = "副總經理", 2000, 0)
        End If
    Else       ' 部門 => "管理部門"
        Ar = Array(0, 0, -10000, -7000, -5000, -4000, -3000, -2000, -1000, -500, 500, 55)  '非幹部(獎懲獎金)
        If 單位.Offset(, 7) <= 10 Then
            Ar = Array(0, 0, -25000, -20000, -16000, -12000, -8000, -6000, -4000, -2000, 1000, 75)    '幹部  (獎懲獎金)
            M = Application.Match(職稱代號, Array("高級專員", "二等襄理", "一等襄理", "副經理", "經理"), 0)
            '***沒有的職稱,[副總經理],管理單位如有副總經理(程式執行會產生錯誤)*****************************
            責任額 = Application.Index(Array(100, 600, 700, 800, 900, 2500), M)                         '責任額 陣列(高級專員->100)
           '管理部門沒有副總經理 -> ' 副總獎金 = IIf(職稱代號  = "副總經理", 2000, 0)
        End If
    End If
    單位.Offset(, 3) = 責任額
    '*************************************** F欄 (達成比率％)用公式有兩式可用*******************************
    單位.Offset(, 5) = "=Round(RC[-1] / RC[-2] * 100, 0)"              'R1C1表示法
   '單位.Offset(, 5) = "=Round(" & 單位.Offset(, 4).Address & " / " & 單位.Offset(, 3).Address & "* 100, 0)"
    '*******************************************************************************************************
    達成百分比 = Round(達成額 / 責任額 * 100, 0)
    '單位.Offset(, 5) = 達成百分比
    獎金 = 0
    If 達成額 / 責任額 * 10 < 3 Then
        M = 2
    ElseIf 達成額 / 責任額 * 10 > 10 Then
        M = 10
        獎金 = Ar(UBound(Ar))
    Else
        M = Int(達成額 / 責任額 * 10)
    End If
    單位.Offset(, 6) = Ar(M) + ((達成百分比 - 100) * 獎金) + 副總獎金   'Ar(M) = 獎懲的金額
    '獎金計算公式: = 獎懲的金額+  ((達成100%以上-100)* 獎金) + 副總獎金
End Sub
執行出來會發生錯誤

GBKEE

回復 31# sillykin
沒有檔案無法偵錯

30# 試試看


Tset.rar (20.03 KB)

下載次數: 10

2013-7-23 10:53

GBKEE

回復 33# sillykin

下載 (59.11 KB)

2013-7-23 10:49

   

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim I As Integer
   
4.     With Sheets("單位成績總表")     '*** 請 修改一下 工作表的名稱  ***
   
5.         If Application.CountA(.[A:A]) <> .Cells(.Rows.Count, "A").End(xlUp).Row Then
   
6.             MsgBox "單位別欗 資料不全"
   
7.             End
   
8.         End If
   
9.         Do While .Range("A3").Offset(I) <> ""
   
10.             獎金程式 .Range("A3").Offset(I)
    
11.            I = I + 1
    
12.         Loop
    
13.     End With
    
14. End Sub
    
15. Private Sub 獎金程式(單位 As Range)
    
16.     Dim 部門 As String, 職稱代號 As Variant, 職稱 As String, 非幹部 As Integer, Col As String, M
    
17.     Dim 責任額 As Integer, 達成額 As Long, 獎金 As Integer, 副總獎金 As Integer
    
18.    
    
19.     With Sheets("條件") '工作表
    
20.         部門 = IIf(IsError(Application.Match(單位, .Range("E2", .Range("E2").End(xlDown)), 0)), "營業單位", "管理單位")
    
21.         職稱 = 單位.Offset(, 2)
    
22.         職稱代號 = Application.Match(職稱, .Range("A:A"), 0)                    '尋找職稱的列位
    
23.         If IsError(職稱代號) Then
    
24.             MsgBox IIf(職稱 = "", "職稱 沒有輸入!! ", "職稱 : " & 職稱 & " 找不到!!!"), , 部門
    
25.             End
    
26.         End If
    
27.         非幹部 = .Range("B" & Application.Match("非幹部", .Range("C:C"), 0))
    
28.         'C欗尋找第1 個"非幹部"的列位 帶入B欄中 得到"非幹部"的代號
    
29.         
    
30.         'E欄 管理單位範圍裡 尋找部門的列位 : 沒找到為 "營業單位" ,找到為"管理單位"
    
31.         If 職稱代號 >= 非幹部 Then
    
32.             責任額 = IIf(部門 = "營業單位", .Range("H2"), .Range("J2"))   '可在 H2,J2 修改非幹部的責任額
    
33.             Col = IIf(部門 = "營業單位", "Q", "S")                        '非幹部獎懲標準表挌 : 在"Q欗" 或 "S欗"
    
34.         Else
    
35.            Col = IIf(部門 = "營業單位", "G:G", "I:I")                     '幹部責任額表挌 : 在"G:G欗" 或 "I:I欗"
    
36.            M = Application.Match(職稱, .Range(Col), 0)                    '尋找幹部責任額的職稱位置
    
37.            If IsError(M) Then
    
38.                 MsgBox 部門 & " 中沒有  " & 職稱, , 部門
    
39.                 End
    
40.             End If
    
41.            責任額 = .Range(Col).Cells(M).Offset(, 1)                      '幹部的責任額
    
42.            Col = IIf(部門 = "營業單位", "P", "R")                         '非幹部獎懲標準表挌 : 在"P欗" 或 "R欗"
    
43.         End If
    
44.         單位.Offset(, 3) = 責任額
    
45.         達成額 = 單位.Offset(, 4)
    
46.         達成百分比 = Round(達成額 / 責任額 * 100, 0)
    
47.         單位.Offset(, 5) = 達成百分比
    
48.         單位.Offset(, 7) = 職稱代號
    
49.         If 達成額 / 責任額 * 10 < 3 Then
    
50.             M = 3
    
51.         ElseIf 達成額 / 責任額 * 10 > 10 Then
    
52.             M = 11
    
53.             獎金 = .Range(Col & 12)
    
54.             副總獎金 = IIf(職稱 = "副總經理", 2000, 0)                  '副總達到獎金會在多2000元
    
55.         Else
    
56.             M = Int(達成額 / 責任額 * 10) + 1
    
57.         End If
    
58.         '獎懲的金額 = .Range(Col & M)
    
59.         '獎金計算公式: 獎懲的金額+  ((達成100%以上-100)* 獎金) + 副總獎金
    
60.         '下式為在獎金欗上輸入公式
    
61.         單位.Offset(, 6) = "=" & .Range(Col & M) & " + ((" & 達成百分比 & " - 100) *" & 獎金 & ") +" & 副總獎金
    
62.         '****************************************************************************************
    
63.         '單位.Offset(, 6) = .Range(Col & M) + ((達成百分比 - 100) * 獎金) + 副總獎金  '直接給數值
    
64.     End With
    
65. End Sub

複製代碼

sillykin

回復 35# sillykin


   如回覆31所檢附檔案
大大不好意思...想在請問...三個問題
第一問題
營業部上限最多奬金150,000元
管理部上限最多奬金120,000元
第二問題
假設
資訊室是一個獨立單位..且奬金是另外制定
例如
責任額100
奬金計算方式
達成額130
達成比率130%
達成100%加發250元
計算方式為(達成額/責任額)*100 = 逹成比率（％）   ==>奬金計算為((逹成比率（％） - 100)*達成100每一點加發5元)+達成100%加發250元

計算方式為(130/100)*100 = 130   ==>奬金計算為((130 - 100)*5)+250 = 400元
是否能在條件sheet中加設欄位值；方便更正
營業部上限最多奬金
管理部上限最多奬金
及資訊定控制項目
請大大指教

GBKEE

回復 36# sillykin
資訊室是一個獨立單位
1有無幹部,非幹部之分.
2有無未達100%的獎懲.
3有無上限奬金

sillykin

回復 37# GBKEE


    條件如圖

例如
責任額100
奬金計算方式
達成額130
達成比率130%
達成100%加發250元
計算方式為(達成額/責任額)*100 = 逹成比率（％）   ==>奬金計算為((逹成比率（％） - 100)*達成100每一點加發5元)+達成100%加發250元

非幹部計算方式為(130/100)*100 = 130   ==>奬金計算為((130 - 100)*5)+250 = 400元
  幹部計算方式為(400/200)*100 = 200   ==>奬金計算為((200 - 100)*5)+500= 1,000元
是否能在條件sheet中加設欄位值；方便更正
營業部上限最多奬金150,000元
管理部上限最多奬金120,000元
資訊部上限最多奬金100,000元
及資訊定控制項目
請大大指教

GBKEE

回復 38# sillykin


    Tset.rar (20.84 KB)

下載次數: 10

2013-7-30 09:13