Sub tt()
Dim m As Long
Range("A:B").Interior.ColorIndex = xlNone
For m = 2 To Range("a" & Rows.Count).End(xlUp).Row
If Cells(m, 2) + Cells(m + 1, 2) + Cells(m + 2, 2) + Cells(m + 3, 2) + Cells(m + 4, 2) > 14 Then
Range(Cells(m, 1), Cells(m + 4, 2)).Interior.ColorIndex = 6
m = m + 4
End If
Next m
End Sub
Function Wlookup(str As String, rg As Range, Optional m As Integer = 0, Optional n As Integer = 0)
Dim rng1, rng2 As Range
Dim q, p, i, k, J As Integer
Dim arr
arr = rg
q = rg.Column
i = LBound(arr)
p = UBound(arr)
If m > 0 Then m = m - 1
Set rng1 = Range(Cells(i, q), Cells(p, q))
Set rng2 = rng1.Find(str)
If rng2 Is Nothing Then Wlookup = "不存在"
If n = -1 Then
Set rng2 = rng1.Find(str, , , , , xlPrevious)
Wlookup = rng2.Offset(, m).Text
Exit Function
End If
J = Application.CountIf(rng1, str)
If n > J Then Wlookup = "不存在"
Set rng2 = Cells(i, q)
For k = 1 To J
Set rng2 = rng1.Find(str, rng2)
If n = 0 Or n = 1 Or k = n Then
Wlookup = rng2.Offset(0, m).Text
Exit Function
End If
Next k
End Function
Sub aa()
Dim arr, ar
Cells.ClearContents
arr = Array(13, 2, 3, 4, 6, 7, 8, 9, 22, 32)
Range("a1").Resize(, UBound(arr) + 1) = arr
Range(Cells(1, 6), Cells(65536, 6)).Insert
Cells(1, 6) = 100
ar = Range(Cells(1, 1), Cells(1, UBound(arr) + 1 + 1))
Cells.ClearContents
Range("a1").Resize(, UBound(arr) + 1) = arr
Range("a2").Resize(, UBound(arr) + 2) = ar
End Sub
8组：我不知道呀 上交考试题
先交上吧，第二题不会做。。。
^:Q
请教兰版，我没VBA基础，真答不了此题，请提示如何加入VBA实战营？谢谢提示！^:L
本帖最后由 联乔 于 2012-8-15 11:21 编辑
时间快到了 可第三题没想出更好的
兰版，我已经很努力研究相关题目，可惜自己实践时间太短，无法对您在课上所讲的内容灵活运用，辜负您的努力了，抱歉！！
我只能做出第一题，第二题实在是困难，只能好好研究答案了！！
希望能过关，谢谢老师
Sub 大于14()
Dim i As Integer
Dim j As Integer
With Sheets(1)
For i = 2 To 68
If .Cells(i, 2) + .Cells(i + 1, 2) + .Cells(i + 2, 2) + .Cells(i + 3, 2) + .Cells(i + 4, 2) > 14 Then
Range(.Cells(i, 1), .Cells(i + 4, 2)).Select
Selection.Interior.ColorIndex = 6
i = i + 4
End If
Next
End With
End Sub
Function wlookup(x, y, m As Integer, n As Integer)
Dim i As Integer
Dim j As Integer
m = Application.InputBox(prompt:="请输入要查找的列数")
If m < 0 Then
End Function
Sub 数组()
Dim arr
Dim ar As String
arr = Array(13, 2, 3, 4, 6, 7, 8, 9, 22, 32)
arr(4) = arr(4) & ",100"
arr = Join(arr, ",")
End Sub
yjss0203 发表于 2012-8-15 11:35 static/image/common/back.gif
Sub 大于14()
Dim i As Integer
Dim j As Integer
快到时间了函数刚有眉目 野路子伤不起来的晚没上过课也没用过
二、三题在编写中