【一个非常有技巧的甲乙丙丁问题】

1154945943 · 发表于 2010-10-3 23:45

这个不错，式子有点长，能具体说说公式各部分代表的意思嘛，要套用需要明白意思。

9楼的不错，F9后刷新了，两位的方法都不错，非常谢谢。
对了，F9是什么功能。

另外，你们所说的速度是基于我给的例子，数据非常少。然后我试过了上两位的方法，当我将数据变为1000行的时候，发现其实两个的计算都好慢，基本上都出现卡死没有反应，这怎么解决啊

piny · 发表于 2010-10-3 23:57

F9是自动重算的意思

基本上 1000行的数据用公式本来就快不了

若要追求效率请至vba板求助

香川群子 · 发表于 2010-10-5 13:08

原帖由 1154945943 于 2010-10-3 01:47 发表
希望明天有人帮俺解决，好困。

用数据透视表可以满足要求把。

估计数据多时速度会比较快的。

香川群子 · 发表于 2010-10-5 14:31

原帖由 piny 于 2010-10-3 23:57 发表
F9是自动重算的意思

基本上 1000行的数据用公式本来就快不了

若要追求效率请至vba板求助

Sub PVT_ABC()
t = Timer
r = [a1].End(4).Row
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="数据DATA!R1C1:R" & r & "C4").CreatePivotTable TableDestination:="", TableName:="表ABC"
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)

ActiveSheet.PivotTables("表ABC").RowGrand = False
ActiveSheet.PivotTables("表ABC").AddFields RowFields:=Array("A", "选择题序号")
ActiveSheet.PivotTables("表ABC").PivotFields("选择题序号").Orientation = xlDataField
ActiveSheet.PivotTables("表ABC").PivotFields("求和项:选择题序号").Function = xlCount
DataCopy

ActiveSheet.PivotTables("表ABC").PivotFields("A").Orientation = xlHidden
With ActiveSheet.PivotTables("表ABC").PivotFields("B")
      .Orientation = xlRowField
      .Position = 1
End With
DataCopy

ActiveSheet.PivotTables("表ABC").PivotFields("B").Orientation = xlHidden
With ActiveSheet.PivotTables("表ABC").PivotFields("C")
      .Orientation = xlRowField
      .Position = 1
End With
DataCopy

Application.CommandBars("PivotTable").Visible = False

Application.DisplayAlerts = False
'On Error Resume Next
ActiveWindow.SelectedSheets.Delete
MsgBox "处理 " & r - 1 & " 行数据，耗时 " & Timer - t & " 秒。"
End Sub
Sub DataCopy()
If Right(Range("C4").End(4).Offset(-1, -2), 2) = "汇总" Then Range("C4").End(4).Offset(-1, -2).Delete
Range("A5").Select
Sheets(Range("A4").Value).Range("A1").CurrentRegion.ClearContents
Do Until ActiveCell = "总计"
      Sheets(Range("A4").Value).Range("A1").Offset(0, m) = ActiveCell & "-" & Range("A4")
      n = 1
      Do
         If ActiveCell.Offset(n, 0) = "" Then
            n = n + 1
         ElseIf ActiveCell.Offset(n - 1, 0) <> ActiveCell.Offset(n, 0) Then
            Exit Do
         End If
      Loop
      Sheets(Range("A4").Value).Range("A1").Offset(1, m).Resize(n, 1).Value = ActiveCell.Offset(0, 1).Resize(n, 1).Value
      m = m + 1
      ActiveCell.Offset(n, 0).Select
Loop

End Sub

如果需要知道甲或乙各选择了几个1、几个2……，还需要改进。
但是不知道楼主要不要，要的话数据放哪里？

香川群子 · 发表于 2010-10-5 14:34

处理1000行数据用时0.2秒左右。

处理65535行数据用时0.6秒左右。

		自动登录	找回密码
密码			免费注册

[求助] 【一个非常有技巧的甲乙丙丁问题】