VBA 脚本

来源:互联网 发布:手机音乐后期软件 编辑:程序博客网 时间:2024/06/05 08:36


Sub test()
Dim sheet1 As Worksheet
Set sheet1 = ThisWorkbook.Worksheets("计件")
If TypeName(sheet1.Cells(437, 8).Value) = "Double" Then
MsgBox (TypeName(sheet1.Cells(437, 8).Value))
End If
MsgBox (TypeName(sheet1.Cells(437, 8).Value))
End Sub
Sub compute_salary()




Dim sheet1 As Worksheet
Set sheet1 = ThisWorkbook.Worksheets("计件")


Dim row_num, n As Integer
n = 3
Do Until IsEmpty(sheet1.Cells(n, 1).Value)
n = n + 1
Loop
n = n - 1                                                                  'the rows of the valid data  from 1
Debug.Print ("total_record:" & n)                                                                         ' veriry the total row
                                                                           
Dim m(10000, 2) As String
If n > 10000 Then
   MsgBox ("the total row is bigger then 10000,please slice it apart")
   Exit Sub
End If


If n = 3 Then
MsgBox ("no data to aggregate,program will exit")
Exit Sub
End If
                                                                            'load the name and pay into array
Dim i, j As Integer
i = 3
j = 0                                                                       ' j is the actual unhidden row  from 0
Do Until i > n
   If sheet1.Rows(i).Hidden = False Then
       m(j, 0) = sheet1.Cells(i, 2).Value                        'the employee name
       If TypeName(sheet1.Cells(i, 8).Value) = "Double" Then
              m(j, 1) = sheet1.Cells(i, 8).Value                        'the employee pay  should change later A1
       ElseIf TypeName(sheet1.Cells(i, 8).Value) = "Empty" Then
              m(j, 1) = 0
       Else
              MsgBox ("the row:" & i & " The num: " & 8 & " is not numeric please verify the cell type ")
              Exit Sub
       End If
       j = j + 1
   End If
   i = i + 1
Loop
i = i - 1
j = j - 1
Debug.Print ("unhidden record:" & j)


'Debug.Print ("i:" & i)
'Debug.Print ("j:" & j)
'Debug.Print ("name:" & m(j, 0) & " value:" & m(j, 1))


'find the total employee




Dim k1, k2 As Integer
Dim employee_name(300) As String ' the total employee should less then 300
k1 = 0
k2 = 0
k3 = 0
flag = 0






Do Until k1 > j
 Do Until flag = 1 Or k2 > 300
    If employee_name(k2) = m(k1, 0) Then                                'have duplicate name
       flag = 1
    End If
    k2 = k2 + 1
 Loop
 If flag = 0 Then
    employee_name(k3) = m(k1, 0)
    k3 = k3 + 1
 End If
 flag = 0
 k1 = k1 + 1
 k2 = 0
Loop


k3 = k3 - 1                                                       'actual employee total  from 0
Dim actual_employee_total As Integer
actual_employee_total = k3


Debug.Print ("actual_employee_total: " & actual_employee_total)




'compute salary
Dim salary(300) As Double
k1 = 0
k2 = 0
total_salary = 0


Do Until k1 > actual_employee_total
  Debug.Print ("k1:" & k1)
  Do Until k2 > n
    If m(k2, 0) = employee_name(k1) Then
       total_salary = total_salary + m(k2, 1)
       Debug.Print ("name:" & m(k2, 0) & " pay:" & m(k2, 1))
    End If
    k2 = k2 + 1
  Loop
  salary(k1) = total_salary
  total_salary = 0
  k1 = k1 + 1
  k2 = 0
Loop


' print the result


 For temp = 0 To actual_employee_total Step 1
    Debug.Print ("temp:" & temp)
    Debug.Print (employee_name(temp) & ":" & salary(temp))
 Next temp
 
 ' fill the salary in the sheet
 Dim sheet2 As Worksheet
Set sheet2 = ThisWorkbook.Worksheets("个人金额")




For i = 0 To actual_employee_total Step 1
    For j = 4 To 304 Step 1
        If sheet2.Cells(j, 2).Value = employee_name(i) Then
           sheet2.Cells(j, 7).Value = salary(i)
           Debug.Print ("match j:" & j & "salary:" & salary(i))
        End If
    Next j
Next i
 




Debug.Print (sheet2.Cells(j, 7).Value)
End Sub