设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 2962|回复: 3
打印 上一主题 下一主题

有哪位朋友能帮忙看看这是如何实现的

[复制链接]
跳转到指定楼层
1#
发表于 2008-11-13 12:51:43 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
有哪位朋友能帮忙看看这是如何实现的
上面的是源数据,下面是要求的数据格式


我工作中常用到这样的变换,数据量很大,说复制粘贴的就免开其口吧!

[ 本帖最后由 prclhf 于 2008-11-13 12:55 编辑 ]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅

点击这里给我发消息

2#
发表于 2008-11-13 16:26:51 | 只看该作者
如果真的是数据量很大,倒不建议用纯函数了。试试下面的办法:
里面的公式是:=IF(A1=A2,C1&" "&B2&" ",B2)

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
3#
发表于 2008-11-13 20:16:36 | 只看该作者
每天一自定义函数---My超级字符连接函数

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
4#
发表于 2008-11-13 20:24:47 | 只看该作者
源码公开:
Function My超级字符连接(查找区域 As Range, 查找值, 连接区域 As Range)
Application.Volatile
Dim 所有字符(), 匹配字符(), 连接字符(), S%, I%, a%
表格Mc = 连接区域.Worksheet.Name
    If (查找区域.Columns.Count > 1 And 查找区域.Rows.Count > 1) Or _
       (查找区域.Columns.Count = 1 And 查找区域.Rows.Count = 1) Then
          My超级字符连接 = "参数不正确"
        Exit Function
    End If
    a = 0
  If 查找区域.Columns.Count = 1 Then
     所有字符 = WorksheetFunction.Transpose(查找区域)
     连接字符 = WorksheetFunction.Transpose(连接区域)
      S = UBound(所有字符)
   For I = 1 To S
     If 所有字符(I) = 查找值 Then
      a = a + 1
       ReDim Preserve 匹配字符(1 To a)
       匹配字符(a) = 连接字符(I)
     End If
   Next
  End If
'  ------------------------------------------------
  If 查找区域.Rows.Count = 1 Then
    For Each 匹配单元格 In 查找区域
     If 匹配单元格.Value = 查找值 Then
        a = a + 1
        ReDim Preserve 匹配字符(1 To a)
        匹配字符(a) = Sheets(表格Mc).Cells(连接区域.Row, 匹配单元格(1, 1).Column)
      End If
     Next
  End If
My超级字符连接 = Join(匹配字符, ",")
End Function
欢迎给点意见 我好改进  我不喜欢用&这个字符 特意用数组来写的
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-15 14:24 , Processed in 0.082050 second(s), 28 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

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