Big Excel：宏不运行，Excel 不响应答案

【问题标题】：Big Excel: Makro doesn't run, Excel dosen't respondBig Excel：宏不运行，Excel 不响应
【发布时间】：2019-01-17 16:43:48
【问题描述】：

我有一个问题。我有来自调查的数据，我正在尝试用它填充数据库。它适用于 8 个测试数据集。现在我有大约 1000 个数据集，它没有运行并且 excel 停止响应。该数据库有 18720 行和 61 列，每个单元格都必须计算。它的代码是：

Sub DataBase()

'Set my tables
    Dim Answers As ListObject
    Dim Table As ListObject
    Set Answers = Worksheets("quantitativ").ListObjects("DataQuant")
    Set Table = Worksheets("Database").ListObjects("Tabelle7")

'Set my Ranges for filters (Organizational level, Location, Function...)

    Set OrgRange = Answers.ListColumns(19).Range
    Set LocRange = Answers.ListColumns(20).Range
    Set FuncRange = Answers.ListColumns(22).Range
    Set TrainRange = Answers.ListColumns(23).Range
    Set InvRange = Answers.ListColumns(25).Range

'Set Ranges for Answers to Questions (Scale)
Set Q1 = Answers.ListColumns(26).Range
Set Q2 = Answers.ListColumns(27).Range
Set Q3 = Answers.ListColumns(28).Range
Set Q4 = Answers.ListColumns(29).Range
Set Q5 = Answers.ListColumns(30).Range
Set Q6 = Answers.ListColumns(31).Range
Set Q7 = Answers.ListColumns(32).Range
Set Q8 = Answers.ListColumns(33).Range
Set Q9 = Answers.ListColumns(34).Range
Set Q10 = Answers.ListColumns(35).Range

Set Q11 = Answers.ListColumns(36).Range
Set Q12 = Answers.ListColumns(37).Range
Set Q13 = Answers.ListColumns(38).Range
Set Q14 = Answers.ListColumns(39).Range
Set Q15 = Answers.ListColumns(40).Range
Set Q16 = Answers.ListColumns(41).Range
Set Q17 = Answers.ListColumns(42).Range
Set Q18 = Answers.ListColumns(43).Range
Set Q19 = Answers.ListColumns(44).Range
Set Q20 = Answers.ListColumns(45).Range

Set Q21 = Answers.ListColumns(46).Range
Set Q22 = Answers.ListColumns(47).Range
Set Q23 = Answers.ListColumns(48).Range
Set Q24 = Answers.ListColumns(49).Range
Set Q25 = Answers.ListColumns(50).Range
Set Q26 = Answers.ListColumns(51).Range
Set Q27 = Answers.ListColumns(52).Range
Set Q28 = Answers.ListColumns(53).Range
Set Q29 = Answers.ListColumns(54).Range
Set Q30 = Answers.ListColumns(55).Range

Set Q31 = Answers.ListColumns(56).Range
Set Q32 = Answers.ListColumns(57).Range
Set Q33 = Answers.ListColumns(58).Range
Set Q34 = Answers.ListColumns(59).Range
'Spalte 60 Textantwort
Set Q35 = Answers.ListColumns(61).Range
Set Q36 = Answers.ListColumns(62).Range
Set Q37 = Answers.ListColumns(63).Range
Set Q38 = Answers.ListColumns(64).Range
Set Q39 = Answers.ListColumns(65).Range
'Spalte 66 Textantwort
Set Q40 = Answers.ListColumns(67).Range

Set Q41 = Answers.ListColumns(68).Range
Set Q42 = Answers.ListColumns(69).Range
Set Q43 = Answers.ListColumns(70).Range
'Spalte 71 Textantwort
Set Q44 = Answers.ListColumns(72).Range
Set Q45 = Answers.ListColumns(73).Range
Set Q46 = Answers.ListColumns(74).Range
'Spalte 75 Textantwort
Set Q47 = Answers.ListColumns(76).Range
Set Q48 = Answers.ListColumns(77).Range
Set Q49 = Answers.ListColumns(78).Range
Set Q50 = Answers.ListColumns(79).Range

Set Q51 = Answers.ListColumns(80).Range
Set Q52 = Answers.ListColumns(81).Range
'Spalte 82 Textantwort
Set Q53 = Answers.ListColumns(83).Range
Set Q54 = Answers.ListColumns(84).Range
Set Q55 = Answers.ListColumns(85).Range
Set Q56 = Answers.ListColumns(86).Range
'Spalte 87 Textantwort
Set Q57 = Answers.ListColumns(88).Range
Set Q58 = Answers.ListColumns(89).Range
Set Q59 = Answers.ListColumns(90).Range
Set Q60 = Answers.ListColumns(91).Range

Set Q61 = Answers.ListColumns(92).Range
'Spalte 93 Sinnlos? (Textantwort)
'Spalte 94 Textantwort

'Row variables for For-Loop
Dim r As Long

    With Worksheets("Database")
        'Gehe alle Zeilen der Tabelle durch
        For r = 5 To Table.DataBodyRange.Rows.Count + 4

            'Q1
            .Cells(r, 9).Value = Application.WorksheetFunction.CountIfs(Q1, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q2
            .Cells(r, 10).Value = Application.WorksheetFunction.CountIfs(Q2, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q3
            .Cells(r, 11).Value = Application.WorksheetFunction.CountIfs(Q3, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q4
            .Cells(r, 12).Value = Application.WorksheetFunction.CountIfs(Q4, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q5
            .Cells(r, 13).Value = Application.WorksheetFunction.CountIfs(Q5, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q6
            .Cells(r, 14).Value = Application.WorksheetFunction.CountIfs(Q6, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q7
            .Cells(r, 15).Value = Application.WorksheetFunction.CountIfs(Q7, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q8
            .Cells(r, 16).Value = Application.WorksheetFunction.CountIfs(Q8, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q9
            .Cells(r, 17).Value = Application.WorksheetFunction.CountIfs(Q9, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

           'Q10
            .Cells(r, 18).Value = Application.WorksheetFunction.CountIfs(Q10, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

           'Q11
            .Cells(r, 19).Value = Application.WorksheetFunction.CountIfs(Q11, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q12
            .Cells(r, 20).Value = Application.WorksheetFunction.CountIfs(Q12, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q13
            .Cells(r, 21).Value = Application.WorksheetFunction.CountIfs(Q13, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q14
            .Cells(r, 22).Value = Application.WorksheetFunction.CountIfs(Q14, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q15
            .Cells(r, 23).Value = Application.WorksheetFunction.CountIfs(Q15, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q16
            .Cells(r, 24).Value = Application.WorksheetFunction.CountIfs(Q16, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q17
            .Cells(r, 25).Value = Application.WorksheetFunction.CountIfs(Q17, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q18
            .Cells(r, 26).Value = Application.WorksheetFunction.CountIfs(Q18, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q19
            .Cells(r, 27).Value = Application.WorksheetFunction.CountIfs(Q19, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

           'Q20
            .Cells(r, 28).Value = Application.WorksheetFunction.CountIfs(Q20, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

           'Q21
            .Cells(r, 29).Value = Application.WorksheetFunction.CountIfs(Q21, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q22
            .Cells(r, 30).Value = Application.WorksheetFunction.CountIfs(Q22, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q23
            .Cells(r, 31).Value = Application.WorksheetFunction.CountIfs(Q23, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q24
            .Cells(r, 32).Value = Application.WorksheetFunction.CountIfs(Q24, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q25
            .Cells(r, 33).Value = Application.WorksheetFunction.CountIfs(Q25, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q26
            .Cells(r, 34).Value = Application.WorksheetFunction.CountIfs(Q26, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q27
            .Cells(r, 35).Value = Application.WorksheetFunction.CountIfs(Q27, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q28
            .Cells(r, 36).Value = Application.WorksheetFunction.CountIfs(Q28, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q29
            .Cells(r, 37).Value = Application.WorksheetFunction.CountIfs(Q29, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q30
            .Cells(r, 38).Value = Application.WorksheetFunction.CountIfs(Q30, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q31
            .Cells(r, 39).Value = Application.WorksheetFunction.CountIfs(Q31, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q32
            .Cells(r, 40).Value = Application.WorksheetFunction.CountIfs(Q32, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q33
            .Cells(r, 41).Value = Application.WorksheetFunction.CountIfs(Q33, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q34
            .Cells(r, 42).Value = Application.WorksheetFunction.CountIfs(Q34, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q35
            .Cells(r, 43).Value = Application.WorksheetFunction.CountIfs(Q35, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q36
            .Cells(r, 44).Value = Application.WorksheetFunction.CountIfs(Q36, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q37
            .Cells(r, 45).Value = Application.WorksheetFunction.CountIfs(Q37, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q38
            .Cells(r, 46).Value = Application.WorksheetFunction.CountIfs(Q38, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q39
            .Cells(r, 47).Value = Application.WorksheetFunction.CountIfs(Q39, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

           'Q40
            .Cells(r, 48).Value = Application.WorksheetFunction.CountIfs(Q40, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

'Q41
            .Cells(r, 49).Value = Application.WorksheetFunction.CountIfs(Q41, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q42
            .Cells(r, 50).Value = Application.WorksheetFunction.CountIfs(Q42, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q43
            .Cells(r, 51).Value = Application.WorksheetFunction.CountIfs(Q43, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q44
            .Cells(r, 52).Value = Application.WorksheetFunction.CountIfs(Q44, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q45
            .Cells(r, 53).Value = Application.WorksheetFunction.CountIfs(Q45, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q46
            .Cells(r, 54).Value = Application.WorksheetFunction.CountIfs(Q46, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q47
            .Cells(r, 55).Value = Application.WorksheetFunction.CountIfs(Q47, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q48
            .Cells(r, 56).Value = Application.WorksheetFunction.CountIfs(Q48, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q49
            .Cells(r, 57).Value = Application.WorksheetFunction.CountIfs(Q49, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

           'Q50
            .Cells(r, 58).Value = Application.WorksheetFunction.CountIfs(Q50, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

'Q51
            .Cells(r, 59).Value = Application.WorksheetFunction.CountIfs(Q51, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q52
            .Cells(r, 60).Value = Application.WorksheetFunction.CountIfs(Q52, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q53
            .Cells(r, 61).Value = Application.WorksheetFunction.CountIfs(Q53, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q54
            .Cells(r, 62).Value = Application.WorksheetFunction.CountIfs(Q54, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q55
            .Cells(r, 63).Value = Application.WorksheetFunction.CountIfs(Q55, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q56
            .Cells(r, 64).Value = Application.WorksheetFunction.CountIfs(Q56, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q57
            .Cells(r, 65).Value = Application.WorksheetFunction.CountIfs(Q57, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q58
            .Cells(r, 66).Value = Application.WorksheetFunction.CountIfs(Q58, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

            'Q59
            .Cells(r, 67).Value = Application.WorksheetFunction.CountIfs(Q59, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

           'Q60
            .Cells(r, 68).Value = Application.WorksheetFunction.CountIfs(Q60, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

'Q61
            .Cells(r, 69).Value = Application.WorksheetFunction.CountIfs(Q61, _
        .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
        .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))

        Next r

    End With


End Sub

有没有办法改进代码以使其运行，或者你们中的任何人有其他想法来解决它吗？非常感谢。

【问题讨论】：

不响应的部分可能只是 Excel 专用资源来计算值。鉴于有 18720 行，您可能不会立即获得输出。也许尝试关闭屏幕更新和计算以加快速度。
可能实际上 Excel 没有响应因为宏运行并且需要很长时间。 Excel 运行时没有响应。尝试使用数组或循环来减少代码并使用函数而不是重复代码。 • 很不清楚您在这里要做什么。因此，如果您可以在您的问题 (edit) 中解释您实际上想要做什么，那么可能会有更好的方法。屏幕截图可能有助于解释。
首先尝试将计算设置为手动：Application.Calculation = xlManual。并关闭屏幕更新：Application.ScreenUpdating = False。并在代码的末尾将两者都转回Application.Calculation = xlAutomatic Application.ScreenUpdating = True
你在循环内的一行中实际做的是让Excel遍历所有18K行，每行进行6次比较以决定是否增加计数器。这进行了 18K*18K*6*61 的比较。所以它只是重载了 Excel。它会起作用，但不要期望快速响应。您可以在循环中使用Application.StatusBar = "Processing " & CStr(r) 来跟踪进度。我建议使用@Zsmaster 的 cmets 并使用前 20 行测试 sub。如果没问题，你只需要耐心。
真的有必要Set 61 Range对象吗？这是很多内存分配。快速浏览一下您的代码，看起来很多代码都可以通过forloop 进行简化

标签： vba excel runtime

【解决方案1】：

应该可以简化成这样的代码：

我使用了一个数组来存储问题的列号，这样我们就可以轻松循环。我还添加了状态栏更新，以便您可以查看正在处理的行。由于有很多迭代，它仍然需要时间。

我还添加了一个计时器，因此您将看到处理一行的平均时间和处理所有行的估计时间。但请注意，状态栏更新会增加额外的（甚至是最小的）负载。

Public Sub DataBase()
    'Set my tables
    Dim Answers As ListObject
    Dim Table As ListObject
    Set Answers = Worksheets("quantitativ").ListObjects("DataQuant")
    Set Table = Worksheets("Database").ListObjects("Tabelle7")

    'Set my Ranges for filters (Organizational level, Location, Function...)
    Set OrgRange = Answers.ListColumns(19).Range
    Set LocRange = Answers.ListColumns(20).Range
    Set FuncRange = Answers.ListColumns(22).Range
    Set TrainRange = Answers.ListColumns(23).Range
    Set InvRange = Answers.ListColumns(25).Range

    'Set Ranges for Answers to Questions (Scale)
    Dim QuestionColumns As Variant
    QuestionColumns = Array(26, 27, 28, 29, 30, 31, 32, 33, 34, 35, _
                            26, 37, 38, 39, 40, 41, 42, 43, 44, 45, _
                            46, 47, 48, 49, 50, 51, 52, 53, 54, 55, _
                            56, 57, 58, 59, 61, 62, 63, 64, 65, 67, _
                            68, 69, 70, 72, 73, 74, 76, 77, 78, 79, _
                            80, 81, 83, 84, 85, 86, 88, 89, 90, 91, _
                            92)


    Dim QuestionColumn As Variant
    Dim c As Long

    Dim rStart As Long: rStart = 5
    Dim rEnd As Long: rEnd = Table.DataBodyRange.Rows.Count + 4

    Dim StartTime As Double
    StartTime = Timer

    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    With Worksheets("Database")
        Dim r As Long
        For r = rStart To rEnd 'Gehe alle Zeilen der Tabelle durch
            'update statusbar
            Application.StatusBar = "Processing Row " & CStr(r) & _
                                    ", Runtime: " & Format(Timer - StartTime, "0.00s") & _
                                    ", Time per row: " & Format((Timer - StartTime) / (r - rStart + 1), "0.00s") & _
                                    ", Estimated time: " & Format((Timer - StartTime) / (r - rStart + 1) * (rEnd - rStart), "0.00s") & _ 
                                    ", Time left: " & Format(((Timer - StartTime) / (r - rStart + 1) * (rEnd - rStart)) - (Timer - StartTime), "0.00s")
            DoEvents

            c = 9
            For Each QuestionColumn In QuestionColumns                    
                .Cells(r, c).Value = Application.WorksheetFunction.CountIfs(Answers.ListColumns(CLng(QuestionColumn)).Range, _
                                     .Cells(r, 8), OrgRange, .Cells(r, 1), LocRange, .Cells(r, 2), FuncRange, _
                                     .Cells(r, 4), InvRange, .Cells(r, 7), TrainRange, .Cells(r, 5))
                c = c + 1
            Next QuestionColumn
        Next r
    End With

    Application.StatusBar = "Done."

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

【讨论】：