2023年12月2日发(作者：)

学习使人进步

注意1：如下这两句意思相同，都是判断sheet1的E列中大于maxv * r的单元格个数。

nv < f(s("E:E"), ">" & maxv * r)

nv < f(s("E:E"), ">" & Cstr(maxv * r))

注意2:在vba中默认是，而不是，同理，sheets(i)默认是(i)，而不是(i)。当前thisworkbook指的是当前vba代码所在的workbook，thisworkbook不一定是activeworkbook，activeworkbook指的是人工或者vba命令最新打开或者编辑的workbook。一定要注意这一点。

主函数

Public Sub abcmodified()

Dim MyFile As String

Dim nam, nam1 As String

Dim num As Integer

'vv = ox(prompt:="请输入取值范围（0~1）", Type:=1)

MyFile = Dir( & "*.csv")

'MyFile = Dir("C:UsersliyangtjuDesktop新建文件夹" & "*.csv")

'读入文件夹中的第一个.csv文件

Do While MyFile <> ""

Filename:= & "" & MyFile

MyFile

flag = 0

For i = 1 To '注意这里如果是那么寻找的就是当前活动的workbook的sheets的数目

If Left(MyFile, Len(MyFile) - 4) = (i).Name Then

MsgBox "hello"

flag = 1

Exit For

End If

Next i

If flag = 1 Then

GoTo kk

End If

yAlerts = False

Set arr = Workbooks(MyFile).Sheets(1).Cells '注意这里得有.cells如果没有.cells，那么复制的是sheet1中的vba代码内容

te

("Sheet1").Activate

("Sheet1").Cells(1, 1).Select

pecial Paste:=xlPasteAll

UserDefinedFunction

num =

After:=(num) '在当前所有所有sheet中最后一个sheet后新建一个sheet

s =

(s).Activate

(s).Cells(1, 1).Select

pecial Paste:=xlPasteAll

strname = Left(MyFile, Len(MyFile) - 4)

Sheets(s).Name = strname

Sheets(s).Cells(1, "G").NumberFormatLocal = "0.00%"

Sheets(s).Cells(1, "G").HorizontalAlignment = xlCenter

'Sheets(s).Activate

Sheets(s).Rows("1:1").Select

'lter lter Field:=7, Criteria1:="<>"

te

ontents

kk: Workbooks(MyFile).Close Savechanges:=True

MyFile = Dir '第二次读入的时候不用写参数

Loop

'For i = 2 To

'Sheets(i).Cells(1, 2).Formula = "=Sheet1!$B$1"

'Next i

End Sub

调用的函数

Public Sub UserDefinedFunction()

te '有了这一句，使得thisworkbook成为activeworkbook

Columns("B:B").Select '这一句全称默认是s("B:B").select

Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Columns("A:A").Select

Columns Destination:=Range("A1"), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _

Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _

:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

Columns("E:E").Select

Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Columns("E:E").Select

Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Columns("E:E").Select

Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Rows("1:1").Select lter

("Sheet1").

("Sheet1"). Key:=Range _

("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

xlSortNormal

With eets("Sheet1").

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

eets("Sheet1").

eets("Sheet1"). Key:=Range _

("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

xlSortNormal

With eets("Sheet1").

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

i = 2

Do

If (i, 1) = "" Then

Exit Do

End If

k = 1

Do

If (i, "A") = (i + 1, "A") Then

k = k + 1

i = i + 1

Else

i = i + 1

Exit Do

End If

Loop

(i - k, "E") = (Range((i - k, "D"), (i - 1,

"D")))

Loop

N = i - 1

For i = 3 To N If (i, "E") = "" Then

(i, "E") = (i - 1, "E")

End If

Next i

maxv = (s("E:E"))

'(1, "F") = 0.5

nv = 1

r = 0.5

Do While r <= 0.9

If nv < fs(s("E:E"), ">" & maxv * r,

s("E:E"), "<" & CStr(maxv * (r + 0.1))) Then

nv = fs(s("E:E"), ">" & maxv * r, s("E:E"),

"<" & maxv * (r + 0.1))

vv = r

End If

r = r + 0.1

Loop

For i = 2 To N '标幺化

If i = 2 Then

temp = i + 1

Else

temp = i

End If

If f((Cells(temp - 2, "D"), Cells(i + 2, "D")),

Cells(i, "E")) > 0 And Cells(i, "E") >= vv * maxv And Cells(i, "E") <= (vv + 0.1) * maxv Then

(i, "F").Formula = "=D" & i & "/max(E2:E" & N & ")"

'If Abs((i, "E") - (i, "D")) / (i, "E") > 0.5 Then

'(i, "F") = 1

'Else

'(i, "F") = 0

'End If

End If

Next i

(1, "F").Formula = "=sum(F2:F" & N & ")/count(F2:F" & N & ")"

For i = 2 To N '求偏差

If i = 2 Then

temp = i + 1

Else

temp = i End If

If f((Cells(temp - 2, "D"), Cells(i + 2, "D")),

Cells(i, "E")) > 0 And Cells(i, "E") >= vv * maxv And Cells(i, "E") <= (vv + 0.1) * maxv Then

(i, "G").Formula = "=(F" & i & "-F" & 1 & ")^2"

'If Abs((i, "E") - (i, "D")) / (i, "E") > 0.5 Then

'(i, "F") = 1

'Else

'(i, "F") = 0

'End If

End If

Next i

'(1, 5) = f((Cells(2, "F"), Cells(N, "F")), 1) / 做好人力资源，企业无忧

((Cells(2, "F"), Cells(N, "F")))

(1, "G").Formula = "=(sum(G2:G" & N & ")/count(G2:G" & N & "))^0.5/F1"

'MsgBox "执行完毕"

End Sub