楼主
嘉昆2011 |
素材来自：
条件查询双列有序提炼
http://www.exceltip.net/thread-49867-1-1.html
问题陈述：
如何根据查询条件，双列显示查询结果？
效果如下图所示：
SQL代码及思路：- Transform Last(员工编号)
- Select Null From
- (Select
- 员工编号,
- DSum("1", "[名单$A:D]", "科室名称='ICU室' And 员工编号<="&员工编号) as 排序,
- Int((排序-1)/20)+1 as 列,
- ((排序-1) Mod 20)+1 as 行
- From [名单$A:D]
- Where 员工编号 IS NOT NULL And 科室名称="ICU室"
- Order by 员工编号
- Union All
- Select
- 姓名,
- DSum("1", "[名单$A:D]", "科室名称='ICU室' And 员工编号<="&员工编号) as 排序,
- Int((排序-1)/20)+1.00001 as 列,
- ((排序-1) Mod 20)+1 as 行
- From [名单$A:D]
- Where 员工编号 IS NOT NULL And 科室名称="ICU室"
- Order by 员工编号
- Union All
- Select
- Format(金额, "0.00") as 金额,
- DSum("1", "[名单$A:D]", "科室名称='ICU室' And 员工编号<="&员工编号) as 排序,
- Int((排序-1)/20)+1.01 as 列,
- ((排序-1) Mod 20)+1 as 行
- From [名单$A:D]
- Where 员工编号 IS NOT NULL And 科室名称="ICU室"
- Order by 员工编号)
- Group by 行
- Pivot 列
1，利用域聚合函数DSum记录符合条件的记录；
2，然后利用Int函数和Mod运算对记录分配“坐标”；
3，利用配权思想和联合查询将各字段信息组合起来；
4，交叉表查询输出模拟结果。
模拟效果：
附件：
 举例.rar
|
2楼
LOGO |
用SQL语句来处理感觉速度有点慢(可能是我机子的问题)，且列标题的添加也是个问题。个人偏向于用VBA数组解决(已编辑采录一帖)
http://www.exceltip.net/thread-49888-1-1.html
- Sub human()
- Dim arr, 总数 As Integer, 行数, 列数, 目标数, 结果(), 标题, i As Integer, 结果行号
- Application.ScreenUpdating = False
- Application.Calculation = xlCalculationManual
- [I1].CurrentRegion.Clear
- With ActiveSheet
- arr = Range("a1:d" & Cells(Rows.Count, 1).End(xlUp).Row)
- End With
- 总数 = WorksheetFunction.CountIf(Range("B1:B" & Cells(Rows.Count, 1).End(xlUp).Row), "ICU室")
- 行数 = 20 '固定分成20行数据+1行标题
- 列数 = WorksheetFunction.RoundUp(总数 / 行数, 0) * 3 '目标数据总共有3列
- 标题 = Array("工资编号", "姓名", "金额")
- ReDim 结果(1 To 行数+1, 1 To 列数)
- For i = 1 To 列数
- 结果(1, i) = 标题((i - 1) Mod 3)
- Next
- For i = 2 To UBound(arr)
- If arr(i, 2) = "ICU室" Then
- 目标数 = 目标数 + 1
- 结果行号 = (目标数 - 1) Mod 行数 + 2
- 结果(结果行号, (WorksheetFunction.RoundUp(目标数 / 行数, 0) - 1) * 3 + 1) = arr(i, 1)
- 结果(结果行号, (WorksheetFunction.RoundUp(目标数 / 行数, 0) - 1) * 3 + 2) = arr(i, 3)
- 结果(结果行号, (WorksheetFunction.RoundUp(目标数 / 行数, 0) - 1) * 3 + 3) = Round(arr(i, 4), 2)
- End If
- Next
- [I1].Resize(行数+1, 列数) = 结果
- Application.ScreenUpdating = True
- Application.Calculation = xlCalculationAutomatic
- End Sub
|