Office中国论坛/Access中国论坛

标题: 求高手帮我合并两段代码 [打印本页]

---

作者: wbjiqpl    时间: 2018-1-11 13:19
标题: 求高手帮我合并两段代码
想把长的代码做一下修改，就是改为双击A列不触发。然后将段的合并长的里面。求高手帮忙，小弟先谢了！

1. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
2.     If Target.Count <> 1 Then Exit Sub
   
3.     If Application.Intersect([a2:a50], Target) Is Nothing Then Exit Sub
   
4. 
   
5.     Target.Offset(0, 1).Resize(1, 3).Value = ""
   
6.     r = Target.Row
   
7.     Cells(r, "g") = ""
   
8.     Cells(r, "j") = ""
   
9.     Cells(r, "u") = ""
   
10. End Sub

复制代码

1. Sub FillLvw(Lvw As ListView, QueryColumn As Byte, QueryStr As String)       '此过程用于填充listview项或查询
   
2.     Dim Arr()
   
3.     Dim Item As ListItem    'ListView列表项
   
4.     Dim r As Integer        '库存数据表总行数
   
5.     Dim c As Integer        '库存数据表总列数
   
6.     Dim i As Integer
   
7.     Dim n As Byte
   
8.     With Sheet4
   
9.         c = .Range("A1").End(xlToRight).Column  '取得行号
   
10.         r = .Range("A65536").End(xlUp).Row      '取得总列号
    
11.         If r = 1 Then Exit Sub
    
12.         Arr = .Range("A2:" & Chr(64 + c) & r)   '初始化数组
    
13.     End With
    
14.     Lvw.ListItems.Clear                         '清除Listview所有项
    
15.     For i = 1 To r - 1                          '循环赋数组值给Lvw
    
16.         If InStr(1, Arr(i, QueryColumn), QueryStr) > 0 Then   '判断数组某列中是否包含要查询的内容,如果有就添加列表项
    
17.             Set Item = Lvw.ListItems.Add()
    
18.             Item.Text = Arr(i, 1)                   '列表项文本
    
19.             For n = 2 To c
    
20.                 Item.SubItems(n - 1) = Arr(i, n)    '列表项后面几列文本
    
21.             Next
    
22.             Set Item = Nothing
    
23.         End If
    
24.     Next
    
25. End Sub
    

复制代码

---

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)

Powered by Discuz! X3.3