冠军欧洲2010 发表于 2012-2-29 07:51

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

本帖最后由 冠军欧洲2010 于 2012-3-6 20:29 编辑

说明:
统计帖每个学员只能跟帖回复一次，也就是在原来回复楼层的基础上点编缉，不要一个链接一层楼，否则不计算积分。
各小组学员上交作业时，一定要点击“我要参加”，并注明自己的新组编号和论坛ID，如果点击过“我要参加”但没有跟帖提交作业的，扣该学员5积分；如果跟帖提交了作业，但没有点“我要参加”的，不给予评分。

请各学员看清上面的说明，免得被扣了分分！
本帖为仅楼主可见帖，直接回复即可！

第八课（第九讲）作业链接：
http://www.excelpx.com/thread-224709-1-1.html


yu20078 发表于 2012-2-29 08:32

[hide
]Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook, sh As Worksheet, rng As Range
Set sh = ThisWorkbook.ActiveSheet
If sh.Name = "Sheet1" And Target.Address = "$E$5" Then
    Application.ScreenUpdating = False
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\价格表.xls")
    ThisWorkbook.Activate
    For Each rng In wb.Sheets("sheet1").Range("a1:a7")
            If rng = sh.Range("e5").Value Then
                sh.Range("e7") = rng.Offset(0, 1).Value
                wb.Close False
                Exit Sub
            End If
    Next rng
    sh.Range("e7") = "查找不到"
    wb.Close False
    Application.ScreenUpdating = True
End If
End Sub



hrpotter 发表于 2012-2-29 09:11

C12:hrpotter

wenchduan 发表于 2012-2-29 09:29

本帖最后由 wenchduan 于 2012-2-29 23:00 编辑

A组长:wenchduan

无聊的疯子 发表于 2012-2-29 09:34

A03:无聊的疯子

zjcat35 发表于 2012-2-29 10:09

E02:zjcat35   交作业      

从从容容 发表于 2012-2-29 11:06

D03从从容容

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim JGB 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 JGB = Workbooks.Open(ThisWorkbook.Path & "/价格表.xls")
      For Each i In JGB.Sheets("sheet1").Range("a1:a12")
            If i = Target Then
                S = i.Offset(, 1)
                GoTo 100
            End If
      Next
      S = "查找不到"
    End If
100: JGB.Close
    Range("e7") = S
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

我不知道呀 发表于 2012-2-29 11:58

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim i As Integer
    Dim arr
    Dim price As Object
    Set price = Workbooks.Open(ThisWorkbook.Path & "\价格表.xls")
    arr = Application.Transpose(price.Sheets("Sheet1").Range("a1:b7"))
    If sh.Name = "Sheet1" And Target.Address = "$E$5" Then
      For i = 1 To 7
            If arr(1, i) = Target.Value Then
                Workbooks("练习题.xls").Sheets("Sheet1").Range("e7") = arr(2, i)
                Exit For
            Else
                Workbooks("练习题.xls").Sheets("Sheet1").Range("e7") = "查找不到"
            End If
      Next
      price.Close
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

想飞的鸟 发表于 2012-2-29 13:27

因为代码不好粘贴,所以上传附件,不知行不行

dsjohn 发表于 2012-2-29 15:40

作业做完，请老师修改，谢谢！
页: [1] 2 3 4 5 6 7
查看完整版本: 统计VBA学习小组正式组第八课（第九讲）的积分帖之作业上交贴（第10周）