求高手指点excel VBA程序编写

需要用VBA吗？在excel表格里用总分排序不就得了？

sub 获得奖学金名单（）

dim ws1 as worksheet

dim ws2 as worksheet

set ws1 = sheets("你的excel文件名字")

set ws2=sheets("存放结果的工作表")

ws1select

Range("A1:I" & 尾行)Select

SelectionSort Key1:=Range("H1"), Order1:=xlDescending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _

:=xlPinYin, DataOption1:=xlSortNormal

ws2cells(1,1)value="奖项"

ws2cells(1,2)value="班级"

ws2cells(1,3)value="学生姓名"

for i=1 to 10

if i=1 then

msgbox "一等奖： " & ws1cells(i+1,1)value & " 的 " & ws1cells(i+1,2)value '班级和学生名字

ws2cells(i+1,1)="一等奖"

ws2cells(i+1,2)=ws1cells(i+1,1)value

ws2cells(i+1,3)=ws1cells(i+1,2)value

end if

if i>=2 or i<=4 then

msgbox "二等奖： " & cells(i+1,1)value & " 的 " & cells(i+1,2)value '班级和学生名字

ws2cells(i+1,1)="二等奖"

ws2cells(i+1,2)=ws1cells(i+1,1)value

ws2cells(i+1,3)=ws1cells(i+1,2)value

end if

if i>=5 or i<=10 then

msgbox "三等奖： " & cells(i+1,1)value & " 的 " & cells(i+1,2)value '班级和学生名字

ws2cells(i+1,1)="三等奖"

ws2cells(i+1,2)=ws1cells(i+1,1)value

ws2cells(i+1,3)=ws1cells(i+1,2)value

end if

next i

end sub

function 尾行()

尾行 = sheets("你的excel文件名字")Range("B65536")End(xlUp)Row

end function

干嘛要搞那么复杂呢？—— 但编程的话也大概就是这么个意思，如果你理解了可以根据需要输出的格式随心所欲地重新编程。

CInt("156") '= 16,转换为整形

CDate("260") '1900/1/1 14：24：00 ，转换为日期

-------------

函数 返回类型 expression 参数范围

CBool Boolean 任何有效的字符串或数值表达式。

CByte Byte 0 至 255。

CCur Currency -922,337,203,685,4775808 至922,337,203,685,4775807。

CDate Date 任何有效的日期表达式。

CDbl Double 负数从 -179769313486231E308 至 -494065645841247E-324；正数从 494065645841247E-324 至 179769313486232E308。

CDec Decimal 零变比数值，即无小数位数值，为

+/-79,228,162,514,264,337,593,543,950,335。对于 28 位小数的数值，范围则为

+/-79228162514264337593543950335；最小的可能非零值是 00000000000000000000000000001。

CInt Integer -32,768 至 32,767，小数部分四舍五入。

CLng Long -2,147,483,648 至 2,147,483,647，小数部分四舍五入。

CSng Single 负数为 -3402823E38 至 -1401298E-45；正数为 1401298E-45 至 3402823E38。

CStr String 依据 expression 参数返回 Cstr。

CVar Variant 若为数值，则范围与 Double 相同；若不为数值，则范围与 String 相同。

在工作表插入一命令按钮，并编程如下：

Private Sub CommandButton1_Click()

Range("E:J")ClearContents

Range("E1")Formula = "=IF(COUNTIF(D:D,B1),ROW(B1),ROW(B1)+COUNT(B:B))"

Range("E1")AutoFill Destination:=Range("E1:E" & Range("B65536")End(xlUp)Row), Type:=xlFillDefault

Range("F1")Formula = "=IF(COUNTIF(B:B,D1),ROW(D1),ROW(D1)+COUNT(D:D))"

Range("F1")AutoFill Destination:=Range("F1:F" & Range("D65536")End(xlUp)Row), Type:=xlFillDefault

Range("G1")Formula = "=INDIRECT(" & Chr(34) & "A" & Chr(34) & "&IF(SMALL(E:E,ROW())<=COUNT(B:B),SMALL(E:E,ROW()),SMALL(E:E,ROW())-COUNT(B:B)))"

Range("H1")Formula = "=INDIRECT(" & Chr(34) & "B" & Chr(34) & "&IF(SMALL(E:E,ROW())<=COUNT(B:B),SMALL(E:E,ROW()),SMALL(E:E,ROW())-COUNT(B:B)))"

Range("G1:H1")AutoFill Destination:=Range("G1:H" & Range("B65536")End(xlUp)Row), Type:=xlFillDefault

Range("I1")Formula = "=IF(ROW()<=COUNTIF(E:E," & Chr(34) & "<=" & Chr(34) & "&COUNT(B:B)),INDIRECT(" & Chr(34) & "C" & Chr(34) & "&MATCH(H1,D:D,0)),INDIRECT(" & Chr(34) & "C" & Chr(34) & "&SMALL(F:F,ROW())-COUNT(D:D)))"

Range("J1")Formula = "=IF(ROW()<=COUNTIF(E:E," & Chr(34) & "<=" & Chr(34) & "&COUNT(B:B)),H1,INDIRECT(" & Chr(34) & "D" & Chr(34) & "&SMALL(F:F,ROW())-COUNT(D:D)))"

Range("I1:J1")AutoFill Destination:=Range("I1:J" & Range("D65536")End(xlUp)Row), Type:=xlFillDefault

End Sub

直接引用工作表函数

K＝worksheetfunctionMMULT(worksheetfunctionMINVERS(range("A2:C4"),range("A6:C8"))

worksheetfunction是工作表函数对象，可以调用工作表函数，工作表函数中，参数中的区域，可以用RANGE来指定，其他参数一样用。

如果你不适应这样写法，可以用以下方法直接写

K＝evalute("=mmult(A2:C4,A6,C8)")，就是直接把公式放在这个函数中即可

还有用大括号直接写的，但据说速度较慢，你可查看下其他资料

矩阵乘法运算的原理，就一句，新矩阵第i行第j列位置上的数＝第一个矩阵第I行上数与第二个矩阵第J列上的数对应相乘的乘积和。所以要求二个矩阵的第一个行元素个数＝第二个列元素个数。而这种计算的函数，想必你也很熟悉（SUMPRODUCT）！

不知道你是不是要放在工作表的change事件来处理这件事所谓工作表的change事件就是当工作表的单元格内容发生变化后触发这个事件并自动执行相关代码

这是我按你的要求写的放在工作表change事件里的代码 因为不知道回文的位置 所以我假定回文是在A列yes no 输出在B列同行的单元格

Private Sub Worksheet_Change(ByVal Target As Range)

If TargetColumn = 1 Then

Dim FXstr

FXstr = StrReverse(TargetValue)

If FXstr = TargetValue Then

TargetOffset(0, 1) = "YES!"

Else

TargetOffset(0, 1) = "NO!"

End If

End If

End Sub

如果要用宏手动执行用下面的代码 ,假设回文在A1单元格

Sub 检查回文()

Dim FXstr

FXstr = StrReverse(Range("A1")Value)

If FXstr = Range("A1")Value Then

Range("A1")Offset(0, 1) = "YES!"

Else

Range("A1")Offset(0, 1) = "NO!"

End If

End Sub

'本程序日期格式：2012-10-22，2012,10,22其他格式自己调试

Sub auto_open()

Dim StrDate As String

StrDate = Cells(1, 1)

If DateDiff("d", Date, StrDate) < 0 Then

Cells(1, 1) = ""

End If

End Sub

Public Sub PrintResult()

    Dim strStuNum   As String

    Dim strStuName  As String

    strStuNum = InputBox("Student Number:")

    strStuName = InputBox("Student Name:")

    DebugPrint strStuNum

    DebugPrint strStuName

End Sub

运行上述过程后，立即窗口（Ctrl+G）中将输出程序运行时用户输入的学号和姓名。

一定要用VBA么？

for r=2 to 100

if applicationWorksheetFunctionSum(range("M1:X1")offset(r,0))<>0 and applicationWorksheetFunctionSum(range("A1:L1")offset(r,0))>0 then

range("Y1")offset(r,0)=applicationWorksheetFunctionSum(range("A1:L1")offset(r,0))/applicationWorksheetFunctionSum(range("M1:X1")offset(r,0))

endif

next r

=====================================================

好蛋疼啊！

直接用公式多简单：

=IF(AND(SUM(M3:X3)<>0, SUM(A3:L3)>0), SUM(A3:L3)/SUM(M3:X3), "")

以上就是关于求高手指点excel VBA程序编写全部的内容，包括:求高手指点excel VBA程序编写、excel的vba如何插入程序、怎么做做VBA程序等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！