|
楼主 |
发表于 2011-6-13 08:12
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Private Sub Worksheet_Deactivate()
- Dim cn As New ADODB.Connection
- Dim lastrow As Integer
- Dim ddh As String
- Dim i As Integer
- Dim j As Integer
- Dim y As Integer
- Dim p As Integer
- Application.ScreenUpdating = False
- With Worksheets("辅助表")
- .Cells.ClearContents
- .Range("A1:B1") = Split("订单号 货号")
- cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source= " & ThisWorkbook.FullName
- Sql = "select distinct 订单号 from [sheet3$]"
- .[a1].CopyFromRecordset cn.Execute(Sql)
- .Cells(1, 1).Value = "订单号"
- cn.Close
- Set cn = Nothing
- lastrow = .[a65536].End(xlUp).Row
- .Range("a2:a" & lastrow).Name = "订单号"
- Set rng = Sheets("sheet3").Range("a65536")
- For i = 2 To lastrow
- ddh = .Cells(i, 1).Value
- p = 0
- x = Application.WorksheetFunction.CountIf(Sheets("sheet3").Columns("A"), ddh)
- For j = 1 To x
- Set rng = Sheets("sheet3").Columns(1).Find(ddh, rng, xlValues, xlWhole, xlByColumns)
- huohao = rng.Offset(0, 1).Text
- y = Application.WorksheetFunction.CountIf(.Rows(i), huohao)
- If y < 1 Then
- .Cells(i, j + 1 + p) = huohao
- Else
- p = p - 1
- End If
- Next j
- .Range(.Cells(i, 2), .Cells(i, j + 1 + p)).Name = ddh
- Next i
- End With
- Application.ScreenUpdating = True
- End Sub
复制代码 可能很多人对程序法有效性设置不解,特作一下说明:以上代码是基础工作,目的是向隐藏的工作表(辅助表)中导入型号的唯一性,并且型号相对应的货号唯一性,并把订单号作为该订单号里面的货号定义为名称。以便后面有效性代码应用。
如果订单号里面有“-”,请改为下划线,否则程序会报错。(特别提示)
下午再补充一种listbox列表快速输入法。敬请期待……但非最后一种或最后的一种输入法。
[ 本帖最后由 ctp_119 于 2011-6-13 08:19 编辑 ] |
|