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

jxncfxsf 发表于 2012-2-29 16:46

听课时一听就懂，做起来还真是很麻烦，总算OK了。:lol:lol

bikong01 发表于 2012-2-29 21:18

第4个条件没看太明白,等上课听讲解

sunjing-zxl 发表于 2012-2-29 21:28

E学委:sunjing-zxl

生存方式 发表于 2012-2-29 21:29

不知道对不对啊！！

qushui 发表于 2012-2-29 21:42

A组学委:qushuiOption Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "Sheet1" And Target.Address = "$E$5" Then
      Dim a&, b, i&, wb As Workbook
      Application.ScreenUpdating = False
      Set wb = Workbooks.Open(ThisWorkbook.Path & "/价格表.xls")
      With wb.Worksheets(1)
            a = .Cells(65536, 1).End(3).Row
            For i = 2 To a
                If .Cells(i, 1) = Target Then
                  b = .Cells(i, 2)
                  Exit For
                End If
            Next i
      End With
      If i = a + 1 Then b = "查找不到"
      wb.Close
      Cells(7, 5) = b
      Application.ScreenUpdating = True
    End If
End Sub

兰江自由鱼 发表于 2012-2-29 23:49

我也来交作业了，请批改。谢谢！作业中，顺便练习了一下自定义函数。测试了一下，是可行的，只是代码不是很优化。请指点。

qzc804030 发表于 2012-3-1 12:29

E组长:qzc804030

szczm121 发表于 2012-3-1 12:53

g17:szczm121

yl_li 发表于 2012-3-1 13:39

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim wb As Workbook
Dim i As Byte
Dim j As String
On Error Resume Next
    If Sh.Name = "Sheet1" And Target.Address = "$E$5" Then
      Set wb = Workbooks.Open(ThisWorkbook.Path & "\价格表.xls")
      With wb
            For i = 2 To 7
                If .Sheets("sheet1").Cells(i, 1) = Target Then
                  j = .Sheets("sheet1").Cells(i, 2)
                  Exit For
                End If
                j = "查不到"
            Next i
      End With
      wb.Close
      Application.EnableEvents = False
      Sh.Range("e7").Value = j
      Application.EnableEvents = True
    End If
End Sub

sliang28 发表于 2012-3-1 15:06

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SH As Worksheet, 价格 As Workbook, PRICE As Variant, I As Integer, T As Integer
    T = 0
    Set SH = ThisWorkbook.ActiveSheet
      If SH.Name = "Sheet1" And Target.Address = "$E$5" Then
         Set 价格 = Workbooks.Open("C:\Documents and Settings\1010018\桌面\第8课作业题查找\价格表.xls")
             For I = 1 To 10
               If UCase(Target.Value) = UCase(ActiveSheet.Cells(I, 1)) Then '加UCASE就可以不区分大小写
                  PRICE = ActiveSheet.Cells(I, 2)
                  T = 1
                  价格.Close False
                  Exit For
               End If
             Next
      If T <> 1 Then
         价格.Close False
         MsgBox "查找不到"
      Else
         SH.Range("E7") = PRICE
         PRICE = 0
         T = 0
      End If
      End If
   Set SH = Nothing
End Sub

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