[已解决]帖子设置有误，请大神来这观看~

xujunxujing · 发表于 2016-3-22 12:57

本人写了段小程序，用到的主要功能就是查询+返回，程序运行时通过扫描内容自动输出查找内容，返回内容格式必须与EXECL文件中的格式一样，有的字母上带上划线，下划线等，目前代码无法运行，请大神查看之~

Private Sub CommandButton1_Click()

Dim rng As Range, a, b, c

a = TextBox1.Text
b = TextBox2.Text
c = TextBox3.Text
d = TextBox4.Text
With Worksheets("数据源")
.Range("a2").Value = a
If TextBox4.Text = "" Or TextBox5.Text = "" Or TextBox6.Text = "" Then

MsgBox "设备机台号不能为空"
Else
.Range("D7").Value = b
.Range("D8").Value = c
.Range("D9").Value = d

TextBox5.Text = .Range("D1").Value
TextBox6.Text = .Range("D2").Value
TextBox7.Text = .Range("E5").Value
TextBox8.Text = .Range("E6").Value
TextBox9.Text = .Range("H3").Value
TextBox10.Text = .Range("E7").Value
TextBox11.Text = .Range("E8").Value
TextBox12.Text = .Range("E9").Value

If Target.Columns.Count = 1 And Target.Column = 4 And Target.Row >= 2 Then
      Set rng = Range("F13:F" & Range("F" & Rows.Count).End(xlUp).Row).Find(Target, , xlValues, xlWhole)
      If Not rng Is Nothing Then
         rng.Offset(0, 1).Copy Target.Offset(0, 1)
      Else
         Target.Offset(0, 1).Clear
      End If

If Target.Columns.Count = 1 And Target.Column = 4 And Target.Row >= 5 Then
      Set rng = Range("N10:N" & Range("N" & Rows.Count).End(xlUp).Row).Find(Target, , xlValues, xlWhole)
      If Not rng Is Nothing Then
         rng.Offset(0, 1).Copy Target.Offset(0, 1)
      Else
         Target.Offset(0, 1).Clear
      End If

If Target.Columns.Count = 1 And Target.Column = 4 And Target.Row >= 6 Then
Set rng = Range("R13:R" & Range("R" & Rows.Count).End(xlUp).Row).Find(Target, , xlValues, xlWhole)
      If Not rng Is Nothing Then
         rng.Offset(0, 1).Copy Target.Offset(0, 1)
      Else
         Target.Offset(0, 1).Clear
      End If

If Target.Columns.Count = 1 And Target.Column = 4 And Target.Row >= 7 Then
Set rng = Range("V13:V" & Range("V" & Rows.Count).End(xlUp).Row).Find(Target, , xlValues, xlWhole)
      If Not rng Is Nothing Then
         rng.Offset(0, 1).Copy Target.Offset(0, 1)
      Else
         Target.Offset(0, 1).Clear
      End If
If Target.Columns.Count = 1 And Target.Column = 4 And Target.Row >= 8 Then
Set rng = Range("V13:V" & Range("V" & Rows.Count).End(xlUp).Row).Find(Target, , xlValues, xlWhole)
      If Not rng Is Nothing Then
         rng.Offset(0, 1).Copy Target.Offset(0, 1)
      Else
         Target.Offset(0, 1).Clear
      End If
   If Target.Columns.Count = 1 And Target.Column = 4 And Target.Row >= 9 Then
Set rng = Range("V13:V" & Range("V" & Rows.Count).End(xlUp).Row).Find(Target, , xlValues, xlWhole)
      If Not rng Is Nothing Then
         rng.Offset(0, 1).Copy Target.Offset(0, 1)
      Else
         Target.Offset(0, 1).Clear
      End If

End If
End If
End If
End If
End If
End With

End Sub

最佳答案

月排行榜 / 总排行榜

grf1973

2016-3-22 13:56

Private Sub CommandButton1_Click()
Dim rng As Range, a, b, c
a = TextBox1.Text
b = TextBox2.Text
c = TextBox3.Text
d = TextBox4.Text
With Worksheets("数据源")
      a.Range("a2").Value = a
      If TextBox4.Text = "" Or TextBox5.Text = "" Or TextBox6.Text = "" Then
         MsgBox "设备机台号不能为空"
      Else
         .Range("D7").Value = b
         .Range("D8").Value = c
         .Range("D9").Value = d

         TextBox5.Text = .Range("D1").Value
         TextBox6.Text = .Range("D2").Value
         TextBox7.Text = .Range("E5").Value
         TextBox8.Text = .Range("E6").Value
         TextBox9.Text = .Range("H3").Value
         TextBox10.Text = .Range("E7").Value
         TextBox11.Text = .Range("E8").Value
         TextBox12.Text = .Range("E9").Value

         arr = Array("", "", "F", "F", "F", "N", "R", "V", "V", "V") 'D列2--9行所对应要查找的列号
         For i = 2 To 9
            x = .Cells(i, 4) '查找的内容
            xx = arr(i) '在XX列中查找
            Set rng = .Range(.Cells(13, xx), .Cells(13, xx).End(xlDown)).Find(x, , xlValues, xlWhole)
            If Not rng Is Nothing Then
                  rng.Offset(0, 1).Copy .Cells(i, 5)
            Else
                  .Cells(i, 5).Clear
            End If
         Next
      End If
End With
End Sub

跳转到最佳答案楼层

zjdh · 发表于 2016-3-22 13:53

1. 那么多的 If 没相应的End If
2. Target只用于事件，没有用于CommandButton1_Click的！

grf1973 · 发表于 2016-3-22 13:56

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

Private Sub CommandButton1_Click()
Dim rng As Range, a, b, c
a = TextBox1.Text
b = TextBox2.Text
c = TextBox3.Text
d = TextBox4.Text
With Worksheets("数据源")
      a.Range("a2").Value = a
      If TextBox4.Text = "" Or TextBox5.Text = "" Or TextBox6.Text = "" Then
         MsgBox "设备机台号不能为空"
      Else
         .Range("D7").Value = b
         .Range("D8").Value = c
         .Range("D9").Value = d

         TextBox5.Text = .Range("D1").Value
         TextBox6.Text = .Range("D2").Value
         TextBox7.Text = .Range("E5").Value
         TextBox8.Text = .Range("E6").Value
         TextBox9.Text = .Range("H3").Value
         TextBox10.Text = .Range("E7").Value
         TextBox11.Text = .Range("E8").Value
         TextBox12.Text = .Range("E9").Value

         arr = Array("", "", "F", "F", "F", "N", "R", "V", "V", "V") 'D列2--9行所对应要查找的列号
         For i = 2 To 9
            x = .Cells(i, 4) '查找的内容
            xx = arr(i) '在XX列中查找
            Set rng = .Range(.Cells(13, xx), .Cells(13, xx).End(xlDown)).Find(x, , xlValues, xlWhole)
            If Not rng Is Nothing Then
                  rng.Offset(0, 1).Copy .Cells(i, 5)
            Else
                  .Cells(i, 5).Clear
            End If
         Next
      End If
End With
End Sub

grf1973 · 发表于 2016-3-22 13:58

估摸了一下你代码原意，主要修改了红色部分。应该是在底下数据区域查找D列的2--9行，查到内容后放在E列。

grf1973 · 发表于 2016-3-22 13:59

红字部分单独做了按钮供测试。

xujunxujing · 发表于 2016-3-22 17:43

grf1973 发表于 2016-3-22 13:59
红字部分单独做了按钮供测试。

哇，又是你，果然是真大神呀，首先感谢您花时间帮我看代码

对了，我这个里面有个程序界面，文本框里面返回的内容与实际内容不对应，比如说，实际在表格里面是有上下划线的，但是在文本框的反回内容里面就没有,这个我思考了好久，请问有办法吗？

grf1973 · 发表于 2016-3-23 13:29

代码中TextBox5.Text = .Range("D1").Value改为
TextBox5.Text = .Range("D1").Value: TextBox5.Font.Underline = .Range("D1").Font.Underline
其他类推。

xujunxujing · 发表于 2016-3-23 13:55

grf1973 发表于 2016-3-23 13:29
代码中TextBox5.Text = .Range("D1").Value改为
TextBox5.Text = .Range("D1").Value: TextBox5.Font.Unde ...

中午好，按您说的，感觉返回的值全部得有下划线，我原本的意思是根据单元格内是否有上下划线内容进行如实反馈，这样子我想在execl中是不是比较难实现，或者说，文本框内没有办法显示上下划线，今天我想的，是否可以在后面添加一个两行判断语句，根据判断语句的不同返回四种结果：1） 1+1=上下划线有
                                                      2）1+0=上划线有
                                                      3）0+1=下划线有
                                                      4）0+0=返回内容跟单元格一样
至于文本框，我调整了它的属性，让它显示为透明，然后在字符的顶部与底部各添加一个，根据判断语句返回"-"内容，大侠，你觉得我的办法麻烦不?

grf1973 · 发表于 2016-3-23 14:20

不知道你的上划线是怎么设置出来的

xujunxujing · 发表于 2016-3-23 14:27

grf1973 发表于 2016-3-23 14:20
不知道你的上划线是怎么设置出来的

不知道您能不能看懂，是execl的一个小技巧~

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