ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 合并数据求助

[复制链接]

TA的精华主题

TA的得分主题

发表于 2023-7-4 21:30 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
2023-07-04_212620.jpg


请老师帮忙整理一下数据,就是把F 列的用/隔开的数据,如果头尾相连就合并,不相连就维持原样,并写入G列,谢谢老师的帮助
求助.rar (132.73 KB, 下载次数: 27)

TA的精华主题

TA的得分主题

发表于 2023-7-5 07:47 | 显示全部楼层
文件太大,上传不了,请参考以下代码
Sub 按钮1_Click()
Dim i As Long, x As Long, n As Long, r As Long
Dim arr, a
r = Cells(Rows.Count, 6).End(xlUp).Row
arr = Cells(1, 6).Resize(r, 2)
For i = 2 To UBound(arr)
arr(i, 1) = Replace(arr(i, 1), "/", "/-")
a = Split(arr(i, 1), "-")
For x = 0 To UBound(a) - 1
If Val(a(x)) + 1 = Val(a(x + 1)) Then
n = n + 1
a(x) = Empty
Else
If n > 0 Then
  a(x) = Empty
  n = 0
End If
End If
Next 'x,a
Cells(i, 7) = Empty
For x = 0 To UBound(a)
If a(x) <> Empty Then
If Cells(i, 7) = Empty Then
Cells(i, 7) = a(x)
Else
Cells(i, 7) = Cells(i, 7) & "-" & a(x)
End If
End If
Next 'x
Cells(i, 7) = Replace(Cells(i, 7), "/-", "/")
Next 'i
End Sub

评分

2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2023-7-5 08:50 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
请参考附件。。。

求助.rar

320.53 KB, 下载次数: 10

评分

3

查看全部评分

TA的精华主题

TA的得分主题

发表于 2023-7-5 10:26 | 显示全部楼层
  1. Sub testArrayList() '参与练习
  2.   Dim result, ar, br, strData As String
  3.   Dim i As Long, j As Long, Num As Long
  4. '  Dim DynamicArray As New ArrayList '引用 mscorlib.dll
  5.   Dim DynamicArray As Object
  6.   Set DynamicArray = CreateObject("System.Collections.ArrayList")
  7.   result = Range("F2", Cells(Rows.Count, "F").End(xlUp))
  8.   With DynamicArray
  9.     For i = 1 To UBound(result)
  10.       strData = Trim(result(i, 1))
  11.       If Len(strData) Then
  12.         ar = Split(strData, "/")
  13.         For j = 0 To UBound(ar)
  14.           br = Split(ar(j), "-")
  15.           For Num = Val(br(0)) To Val(br(UBound(br)))
  16.             .Add Num
  17.           Next
  18.         Next
  19.         .Sort
  20.         br = .ToArray
  21.         result(i, 1) = br(LBound(br)) & "-"
  22.         For j = LBound(br) + 1 To UBound(br)
  23.           If j < UBound(br) Then
  24.             If br(j) - br(j - 1) <> 1 Then result(i, 1) = result(i, 1) & br(j - 1) & "/" & br(j) & "-"
  25.           Else
  26.             result(i, 1) = result(i, 1) & br(j)
  27.           End If
  28.         Next
  29.       End If
  30.       .Clear
  31.     Next
  32.   End With
  33.   Range("H2").Resize(UBound(result), 1) = result
  34.   Set DynamicArray = Nothing
  35.   Beep
  36. End Sub
复制代码

评分

2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2023-7-5 11:02 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-11-16 22:36 , Processed in 0.032662 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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