ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1028|回复: 7

[求助] 一个单据编号有多个配送方向,去重后确定唯一一个配送方向

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-7-5 11:49 | 显示全部楼层 |阅读模式
目标:确定单据编号对应的配送方向一个单据编号有多个配送方向,通过单位名称去重后,按照配送方向出现次数最多的确定为该单据编号的配送方向。

确定配送方向V1.zip

118.12 KB, 下载次数: 12

TA的精华主题

TA的得分主题

发表于 2018-7-5 12:52 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
不完全实现

确定配送方向V1.rar

129.52 KB, 下载次数: 9

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-7-5 15:32 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

离我想达到的效果还有至少两步,能不能继续帮我优化呢?

TA的精华主题

TA的得分主题

发表于 2018-7-5 16:21 | 显示全部楼层
SQL+字典
  1. Sub Test()
  2.     Dim SH As Worksheet
  3.     Dim lngRows As Long, intTypeNum As Integer
  4.     Dim Conn As Object, Rst As Object, strPath As String
  5.     Dim strConn As String, strSQL As String
  6.     Dim rg As Range
  7.     Dim objDic As Object

  8.     Set SH = Sheets("Sheet1")

  9.     lngRows = SH.Range("E" & Rows.Count).End(xlUp).Row
  10.     If lngRows < 2 Then lngRows = 2
  11.     Sheet1.Range("E2:F" & lngRows).ClearContents

  12.     lngRows = SH.Range("A" & Rows.Count).End(xlUp).Row
  13.     Set rg = SH.Range("E2")

  14.     Set objDic = CreateObject("Scripting.Dictionary")
  15.     Set Conn = CreateObject("ADODB.Connection")
  16.     Set Rst = CreateObject("ADODB.Recordset")
  17.     strPath = ThisWorkbook.FullName
  18.     Select Case Application.Version * 1
  19.         Case Is <= 11
  20.             strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & strPath
  21.         Case Is >= 12
  22.             strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
  23.     End Select

  24.     Conn.Open strConn

  25.     '''''''''''''''''''''''''''''''''
  26.     strSQL = "SELECT A.单据编号, A.配送方向, Count(A.配送方向) AS 计数 " & _
  27.              "FROM (SELECT  单据编号,  配送方向 FROM [Sheet1$A1:C" & lngRows & "] GROUP BY  单据编号, 配送方向, 单位名称)  AS A " & _
  28.              "GROUP BY A.单据编号, A.配送方向 " & _
  29.              "ORDER BY A.单据编号, Count(A.配送方向);"

  30.     Rst.Open strSQL, Conn, 3, 1
  31.    
  32.     If Rst.RecordCount > 0 Then
  33.         Rst.moveFirst
  34.         Do Until Rst.EOF
  35.             objDic(Rst.Fields("单据编号").Value) = Rst.Fields("配送方向").Value & "(" & Rst.Fields("计数").Value & ")"
  36.             Rst.moveNext
  37.         Loop
  38.         
  39.         rg.Resize(objDic.Count, 1) = Application.WorksheetFunction.Transpose(objDic.keys)
  40.         rg.Offset(, 1).Resize(objDic.Count, 1) = Application.WorksheetFunction.Transpose(objDic.items)
  41.     End If

  42.     Set Rst = Nothing
  43.     Set Conn = Nothing
  44. End Sub
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-7-5 17:39 | 显示全部楼层

运行结果OK,感谢大神!能否帮忙注释一下,新手有很多句子看不懂

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-7-5 17:41 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

我自己又加了一步,加上你提供的方法,已经可以运行实现啦

TA的精华主题

TA的得分主题

发表于 2018-7-6 11:22 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
荣儿112233 发表于 2018-7-5 17:39
运行结果OK,感谢大神!能否帮忙注释一下,新手有很多句子看不懂

SQL 语句能看懂的话,就全部明白了

TA的精华主题

TA的得分主题

发表于 2018-7-6 13:10 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2025-1-4 12:05 , Processed in 0.040272 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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