Office中国论坛/Access中国论坛

标题: 有哪位朋友能帮忙看看这是如何实现的 [打印本页]

作者: prclhf 时间: 2008-11-13 12:51
标题: 有哪位朋友能帮忙看看这是如何实现的
有哪位朋友能帮忙看看这是如何实现的
上面的是源数据，下面是要求的数据格式

我工作中常用到这样的变换，数据量很大，说复制粘贴的就免开其口吧！[attach]33165[/attach][attach]33166[/attach]

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

作者: pureshadow 时间: 2008-11-13 16:26
如果真的是数据量很大，倒不建议用纯函数了。试试下面的办法：
里面的公式是：=IF(A1=A2,C1&" "&B2&" ",B2)

作者: 欢欢 时间: 2008-11-13 20:16
[attach]33175[/attach]每天一自定义函数---My超级字符连接函数

作者: 欢欢 时间: 2008-11-13 20:24
源码公开：
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
欢迎给点意见我好改进  我不喜欢用&这个字符特意用数组来写的

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)