ExcelHome技术论坛

 找回密码
 免费注册
QQ登录 只需一步,快速开始
   
高效办公必会的Office99uu优优 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! 国内首部Excel函数公式学习大典 职场充电黑科技, Office微99uu优优 免费下载Excel行业应用视频
300集Office 2010微99uu优优 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 12门Excel免费公开课任你学
你的Excel 201099uu优优学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 124|回复: 8
打印 上一主题 下一主题

[求助] 求一段代码,应该是用字典嵌套的方式或者其它的方法来打开思路

[复制链接]
TA的精华主题TA的得分主题
跳转到指定楼层
1
发表于 2018-1-13 17:59 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式

如图:
我想通过代码解决的问题是,通过A列对产品编码进行一个序号排列,具体行为是:
1.当一个完整款号第一次出现的时候编号为1,后面如果再次出现还是为1.
2.同一型号,但是不同色号的,按照色号进行一个排序,2,3,4……

我现在的做法为:
第一步,先把这一列加入字典,去重复项。将所有的字典的ITEM写为1.
第二步,通过循环对比,如果前4位,一样,再去判断后面两位,如果不一样,则ITEM-1.


-------------------------
但是搞来搞去,得不到我想要的结果。。。不知道 问题在哪儿

求大神直接给段代码,解决我心中的苦闷。

样表.rar 7.16 KB, 下载次数: 12
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 有用有用 无用无用
TA的精华主题TA的得分主题
2
发表于 2018-1-13 18:11 | 只看该作者
  • Sub setNum()
  • Dim lngRow As LongPtr
  • For lngRow = 2 To Cells(Rows.Count, 1).End(xlUp).Row
  •     If Split(Range("A" & lngRow).Value, "-")(0) <> Split(Range("A" & lngRow - 1).Value, "-")(0) Then
  •         Range("B" & lngRow).Value = 1
  •     ElseIf Split(Range("A" & lngRow).Value, "-")(1) <> Split(Range("A" & lngRow - 1).Value & "-", "-")(1) Then
  •         Range("B" & lngRow).Value = Range("B" & lngRow - 1).Value + 1
  •     Else
  •         Range("B" & lngRow).Value = Range("B" & lngRow - 1).Value
  •     End If
  • Next
  • End Sub
  • 复制代码
    TA的精华主题TA的得分主题
    3
     楼主| 发表于 2018-1-13 19:23 | 只看该作者 |楼主

    谢谢亲的支持。。感觉打开了思路。虽然您的代码没有完全解决我的问题。(当中没有彻底解决,有部门没有改变。)
    是否还有大神在线?
    TA的精华主题TA的得分主题
    4
    发表于 2018-1-13 19:39 | 只看该作者
  • Sub 排序号()
  •     Dim vData As Variant, nRow As Double, vKey As Variant, vFill As Variant
  •     Dim oDic As Object
  •    
  •     Set oDic = CreateObject("Scripting.Dictionary")
  •     vData = Sheet1.UsedRange.Value
  •     ReDim vFill(2 To UBound(vData), 1 To 1)
  •     For nRow = 2 To UBound(vData)
  •         vKey = Split(vData(nRow, 1), "-")
  •         If Not oDic.Exists(vKey(0)) Then Set oDic(vKey(0)) = CreateObject("Scripting.Dictionary")
  •         If Not oDic(vKey(0)).Exists(vKey(1)) Then oDic(vKey(0))(vKey(1)) = oDic(vKey(0)).Count + 1
  •         vFill(nRow, 1) = oDic(vKey(0))(vKey(1))
  •     Next
  •     Sheet1.[B2].Resize(UBound(vFill) - 1) = vFill
  • End Sub
  • 复制代码
    TA的精华主题TA的得分主题
    5
    发表于 2018-1-13 19:41 | 只看该作者
    附上附件以供参考
    样表(by.micro).rar 14.31 KB, 下载次数: 3
    TA的精华主题TA的得分主题
    6
     楼主| 发表于 2018-1-13 20:47 | 只看该作者 |楼主
    TA的精华主题TA的得分主题
    7
    发表于 2018-1-13 22:14 | 只看该作者
    '不用字典写个,你示例的结果正确吗?最后有几处不一样

    Option Explicit

    Sub test()
      Dim arr, i, t1, t2, j, n
      arr = Range("a2:b" & Cells(Rows.Count, "a").End(xlUp).Row + 1)
      arr(UBound(arr, 1), 1) = "a-a"
      For i = 1 To UBound(arr, 1) - 1
        t1 = Split(arr(i, 1), "-"): arr(i, 2) = 1: n = 1
        For j = i + 1 To UBound(arr, 1)
          t2 = Split(arr(j, 1), "-")
          If t1(0) <> t2(0) Then i = j - 1: Exit For
          If t1(1) = t2(1) Then
            arr(j, 2) = n
          Else
            n = n + 1: t1(1) = t2(1): arr(j, 2) = n
          End If
      Next j, i
      [a2].Resize(UBound(arr, 1) - 1, 2) = arr
    End Sub
    TA的精华主题TA的得分主题
    8
    发表于 2018-1-13 23:28 | 只看该作者
    书全书店 发表于 2018-1-13 20:47
    您这个代码比较复杂,能给个解读吗??

    能解决问题就行啦,至于理解,你应该好好学习基础之后理解
    TA的精华主题TA的得分主题
    9
    发表于 2018-1-14 09:48 | 只看该作者
    您需要登录后才可以回帖 登录 | 免费注册
    本版积分规则
    关闭

    最新热点上一条 /1 下一条

    关注官方微信,每天坐享新鲜教程
    手机版|关于我们|联系我们|ExcelHome    GMT+8, 2018-1-18 19:45 , Processed in 0.090905 second(s), 12 queries , Gzip On, MemCache On.
    Powered by Discuz! X3.3 © 2001-2017 Wooffice Inc.
        沪公网安备 31011702000001号 沪ICP备11019229号 本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师
    快速回复 返回顶部 返回列表
    99uu优优