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

sliang28 · 发表于 2012-3-1 15:10

忘记写ID了
22楼提交答案者信息如下：

C09：sliang28

linch92413 · 发表于 2012-3-1 21:49

E05:linch92413  交作业
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim MyBok As Workbook
Dim i As Long
Dim Pro As String
Dim D As Long
Pro = Range("e5")
If Sh.Name = "Sheet1" And Target.Address = "$E$5" Then
   For i = 1 To Workbooks.Count
      If Workbooks(1).Name = "价格表.xls" Then GoTo 100
   Next i
   Set MyBok = Workbooks.Open(ThisWorkbook.Path & "\价格表.xls")

100:
   With MyBok.Sheets(1)
      For i = 2 To .Range("a65536").End(xlUp).Row
         If .Range("a" & i) = Pro Then
            D = Range("a" & i).Offset(0, 1)
            Exit For
         End If
      Next i
   End With
   Workbooks("价格表.xls").Close False
   If D = 0 Then
      Range("e7") = "查找不到"
      Exit Sub
   End If
   Range("e7") = D
End If
End Sub

第8课作业题查找(linch92413).rar (17.71 KB, 下载次数: 2)

shengxudong · 发表于 2012-3-1 22:34

总算搞定了，恳请校长下周公布标准代码，也好观摩学习。

梅一枝 · 发表于 2012-3-2 11:29

开始看着作业挺难的，无从下手的感觉，看了5遍视频，翻了N遍书，懂点写点，等写完原来如此……
A06：梅一枝作业：

Option Explicit
Option Compare Text

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sh1
Dim rg As Range
Dim x As Integer
If Sh.Name = "Sheet1" And Target.Address = "$E$5" Then
      Workbooks.Open ThisWorkbook.Path & "/价格表.xls"
   Set sh1 = Workbooks("价格表.xls").Sheets("sheet1")
      For x = 2 To 7

         If Sh.Range("$E$5") = sh1.Range("a" & x) Then
            Sh.Range("$E$7") = sh1.Range("B" & x)
            Exit For
         End If
      Next x
      If x = 8 Then

            Sh.Range("$E$7") = "查找不到"
            End If
End If
End Sub

梅一枝 · 发表于 2012-3-2 11:55

老师，作业中
Dim sh1
Set sh1 = Workbooks("价格表.xls").Sheets("sheet1")
变量SH1明明代表的是sheet 工作表，用DIM SH1 AS SHEETS 不对吗？老提示：编译错误，方法和数据成员未找到。。。。。声明类型为 sheet，workbookS,WORKBOOK,RENGE,等等我都试验过，肯定都错误……只好不声明类型了。为什么呢？这是为什么呢？纠结~
对了，我作业中E5输入的字母可以不区分大小写，也运行成功了，我可以很自豪的大声喊：梅一枝V入门成功！！

老师您辛苦了，多给些积分吧……

君子豹变 · 发表于 2012-3-2 13:11

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 5 And Target.Row = 5 Then
      Workbooks.Open ThisWorkbook.Path & "/价格表.xls"
      Dim x As Integer
      For x = 2 To 7
         If Target.Value = Cells(x, 1) Then
            Target.Offset(2, 0).Value = Cells(x, 2)
         Else
            Target.Offset(2, 0).Value = "查找不到"
         End If
      Next x
End If

End Sub

一缕忧兰 · 发表于 2012-3-2 14:29

A07:一缕忧兰

第8课作业题查找.rar (24.61 KB, 下载次数: 2)

1982zyh · 发表于 2012-3-2 15:01

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim wb As Workbook
Dim a As Integer
Dim str1 As String
Dim str2 As String
Application.ScreenUpdating = False
str1 = ThisWorkbook.Worksheets("Sheet1").Range("E5").Value
If Sh.Name = "Sheet1" And Target.Address = "$E$5" Then
Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\价格表.xls")
wb.Activate
For a = 2 To 7
If Cells(a, 1) = str1 Then
str2 = Cells(a, 2)
End If
Next a
If str2 = "" Then
str2 = "查不到"
End If
wb.Close SaveChanges:=False
ThisWorkbook.Sheets("Sheet1").Range("E7") = str2
End If
Application.ScreenUpdating = True
End Sub

复制代码

1982zyh · 发表于 2012-3-2 15:25

1982zyh 发表于 2012-3-2 15:01

汗，不能编辑了
有个地方写错了，中文的查找不到写成查不到了

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim wb As Workbook
Dim a As Integer
Dim str1 As String
Dim str2 As String
Application.ScreenUpdating = False
str1 = ThisWorkbook.Worksheets("Sheet1").Range("E5").Value
If Sh.Name = "Sheet1" And Target.Address = "$E$5" Then
Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\价格表.xls")
wb.Activate
For a = 2 To 7
If Cells(a, 1) = str1 Then
str2 = Cells(a, 2)
End If
Next a
If str2 = "" Then
str2 = "查找不到"
End If
wb.Close SaveChanges:=False
ThisWorkbook.Sheets("Sheet1").Range("E7") = str2
End If
Application.ScreenUpdating = True
End Sub

复制代码

开心rabbit · 发表于 2012-3-2 16:41

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

		自动登录	找回密码
密码			注册

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

评分

评分

评分

评分

评分

评分