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

开心rabbit

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim sh1 As Object
Dim n As Integer
Dim k As Integer
   If sh.Name = "Sheet1" And Target.Address = "$E$5" Then
      Workbooks.Open (ThisWorkbook.Path & "\价格表.xls")
      Set sh1 = Workbooks("价格表.xls").Sheets("sheet1")
      For n = 2 To 7
       If sh1.Range("a" & n) = sh.Range("E5") Then
          k = sh1.Range("b" & n)
          Exit For
       End If
      Next n
       Workbooks("价格表.xls").Close
       If k = 0 Then
        sh.Range("E7") = "查找不到"
        Else
        sh.Range("E7") = k
       End If
    End If
End Sub

liuho1

VBA学习小组B组 B06 liuho1

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim mbook As Workbook
Dim x As Integer
    If Target.Address = "$E$5" Then
     Set mbook = Workbooks.Open(ThisWorkbook.Path & "\价格表.xls")
      With mbook.Sheets("Sheet1")
        For x = 2 To 7
         If .Cells(x, 1) = Range("E5") Then
           Range("E7") = .Cells(x, 2)
        Exit For
         Else
            Range("E7") = "查找不到"
         End If
        Next
     End With
     mbook.Close savechanges:=False
     Set mbook = Nothing
    End If
End Sub

亦铭

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim I As Integer
If Sh.Name = "Sheet1" And Target.Address = "$E$5" Then
Workbooks.Open ThisWorkbook.Path & "/价格表.xls"
ThisWorkbook.Activate
  For I = 1 To 7
    If Workbooks("价格表.xls").Sheets("Sheet1").Range("A" & I) = Workbooks("练习题.xls").Sheets("Sheet1").Range("e5") Then
      Workbooks("练习题.xls").Sheets("Sheet1").Range("e7") = Workbooks("价格表.XLS").Sheets("Sheet1").Range("b" & I)
      Exit Sub
    End If
  Next
  Workbooks("练习题.xls").Sheets("Sheet1").Range("e7") = "查找不到"
End If
End Sub

xiaoni

VBA基础入门第9讲.rar (43.17 KB, 下载次数: 2)

2012-3-3 05:01 上传

点击文件名下载附件

xxjjdd0000

A01:xxjjdd0000
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim x As Integer
    Dim mysht As Worksheet, sht As Worksheet
    Application.ScreenUpdating = False
        If Target.Address <> "$E$5" Then Exit Sub
        Workbooks.Open "E:\VBA入门基础（第二版）\兰校长入门讲课\第8课作业题查找\价格表.xls"
        For x = 7 To 2 Step -1
            Set sht = Workbooks("练习题.xls").Sheets("sheet1")
            Set mysht = Workbooks("价格表.xls").Sheets("sheet1")
        If sht.Range("E5") Like mysht.Range("a" & x) Then
            sht.Range("E7") = mysht.Range("b" & x)
        Exit For
        End If
        Next
        If sht.Range("E5") <> mysht.Range("a" & x) Then
            sht.Range("E7") = "查找不到"
        End If
        Workbooks("价格表.xls").Close
        Application.ScreenUpdating = True
End Sub 第8课作业题查找.rar (13.68 KB, 下载次数: 2)

2012-3-3 11:08 上传

点击文件名下载附件

寂寞深水鱼

F18:寂寞深水鱼

1. 
   
2. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   
3. Application.ScreenUpdating = False
   
4. Dim wb As Workbook
   
5. Dim X As Integer, k As Integer
   
6. If Sh.Name = "Sheet1" And Target.Address = "$E$5" Then
   
7.      Set wb = Workbooks.Open(ThisWorkbook.Path & "/价格表.xls")
   
8.       For X = 2 To 7
   
9.             If wb.Sheets("sheet1").Cells(X, 1) = ThisWorkbook.Worksheets("sheet1").Range("e5") Then
   
10.             k = wb.Sheets("sheet1").Cells(X, 2)
    
11.            End If
    
12. Next X
    
13. wb.Close
    
14.      If k = 0 Then
    
15.          Range("e7") = "查找不到"
    
16.       Else
    
17.          Range("e7") = k
    
18.        End If
    
19. End If
    
20. Application.ScreenUpdating = True
    
21. End Sub
    

复制代码

雨后的风

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim CP As Range
  Dim DJ As Range
  Set CP = Range("E5")
  Set DJ = Range("E7")
  If Sh.Name = "Sheet1" And Target.Address = "$E$5" Then
    Workbooks.Open ThisWorkbook.Path & "\价格表.xls"
      Dim X%
      For X = 2 To 7
        If CP = Range("A" & X) Then
          DJ = Range("B" & X)
        Exit For
        Else
          DJ = "查找不到"
        End If
      Next X
      Workbooks.Open(ThisWorkbook.Path & "\价格表.xls").Close
  End If
End Sub

@wsm

校长我来交作业了

君子豹变

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   Dim JJB As Workbook
    If Sh.Name = "Sheet1" And Target.Address = "$E$5" Then
      Set JJB = Workbooks.Open(ThisWorkbook.Path & "/价格表.xls")
        Dim x As Integer
        Dim dj
        For x = 2 To 7
            If Target.Value = Cells(x, 1) Then
               dj = Cells(x, 2)
                Target.Offset(2, 0).Value = dj
                'MsgBox (dj)
            Exit For
            Else
                Target.Offset(2, 0).Value = "查找不到"
           End If
          Next x
         JJB.Close
    End If
   
End Sub

ybchxj2010

如果是我设计程序，我不会打开价格表。
另外我喜欢设计价格查询窗体或是列表来处理这样的问题？请老师指点！