论坛 › Excel VBA实战营2期 › 统计VBA学习小组正式组第八课（第九讲）的积分帖之作业上交贴（第10周）

yijundanny 发表于 2012-3-4 20:08

**** Hidden Message *****

海角天涯0 发表于 2012-3-4 21:39

C16：海角天涯0
作业是同学们帮助做的，我是一点思路都没有，还是等老师下次上课讲解了

tcn541 发表于 2012-3-4 21:53

辛苦老师，继续努力

vbamaster 发表于 2012-3-4 22:49

D05:vbamaster

libenwen2011 发表于 2012-3-4 23:50

16组libenwen2011    (UID: 514207)

libenwen2011 发表于 2012-3-4 23:51

16组libenwen2011    (UID: 514207)

jinglingshu 发表于 2012-3-5 00:23

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim rg As Workbook
    Dim i As Range
    Dim S As String
    If Sh.Name = "Sheet1" And Target.Address = "$E$5" Then
      Application.EnableEvents = False
      Application.ScreenUpdating = False
      Set rg = Workbooks.Open(ThisWorkbook.Path & "/价格表.xls")
      For Each i In rg.Sheets("sheet1").
            If i = Target Then
                S = i.Offset(0, 1)
                GoTo 8
            End If
      Next
      S = "查找不到"
    End If
8: rg.Close
    = S
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

wangchangjun 发表于 2012-3-5 06:53

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim x As Integer
    Dim arr()
    ReDim arr(1 To 6, 1 To 2)
    If Sh.Name = "Sheet1" And Target.Address = "$E$5" Then
      Workbooks.Open ("I:\第8课作业题查找\价格表.xls")
      arr = Range("a2:b7")
      Workbooks("价格表.xls").Close
      For x = 1 To 6
            If arr(x, 1) = Range("e5").Value Then
                Range("e7").Value = arr(x, 2)
                Exit Sub
            Else
                Range("e7").Value = "没有找到"
            End If
      Next
    Else
    End If
End Sub

w2001pf 发表于 2012-3-5 07:17

H07:w2001pf

auroral 发表于 2012-3-5 15:41

作业还没批改吧？

查看完整版本: 统计VBA学习小组正式组第八课（第九讲）的积分帖之作业上交贴（第10周）