VBA实战营招生考试题（考试结束）

ybchxj2010

自定义函数题，个人觉得实用性太差！如果给一个不会VBA的人使用，函数参数多而且无语法提示，要弄懂其用法其实不是很简单。个人愚见！望老师见谅

jxncfxsf

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组：我不知道呀 上交考试题

冠军欧洲2010

先交上吧，第二题不会做。。。

WANGL2

请教兰版，我没VBA基础，真答不了此题，请提示如何加入VBA实战营？谢谢提示！

联乔

时间快到了 可第三题没想出更好的

mengsuiwofei

兰版，我已经很努力研究相关题目，可惜自己实践时间太短，无法对您在课上所讲的内容灵活运用，辜负您的努力了，抱歉！！
我只能做出第一题，第二题实在是困难，只能好好研究答案了！！

联乔

希望能过关，谢谢老师

yjss0203

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

yjss0203 发表于 2012-8-15 11:35
Sub 大于14()
Dim i As Integer
Dim j As Integer

快到时间了  函数刚有眉目   野路子伤不起  来的晚  没上过课  也没用过