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

1154945943

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

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


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

piny

F9是自动重算的意思

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

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

香川群子

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

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

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

香川群子

原帖由 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……，还需要改进。
但是不知道楼主要不要，要的话数据放哪里？

香川群子

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

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