设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

返回列表 发新帖
查看: 72|回复: 0

求高手帮我合并两段代码

[复制链接]
发表于 2018-1-11 13:19:40 | 显示全部楼层 |阅读模式
想把长的代码做一下修改,就是改为双击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.     Target.Offset(0, 1).Resize(1, 3).Value = ""
  5.     r = Target.Row
  6.     Cells(r, "g") = ""
  7.     Cells(r, "j") = ""
  8.     Cells(r, "u") = ""
  9. 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
复制代码


您需要登录后才可以回帖 登录 | 注册

本版积分规则

关闭

站长推荐上一条 /6 下一条

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2018-4-26 00:18 , Processed in 0.083849 second(s), 27 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表