用VBA生成汇总表

Question

目前，我正试图开发一个电子表格，帮助我记录我的大楼内出现故障的对角器/窗口(我在设施管理-业务部门工作)。因为每层楼都有将近140个Windows和80个对角器，而且我们没有标准的方法来记录问题/缺陷，所以我想在Excel 2016中创建一个Excel表格。

现在，因为我有一台触摸屏笔记本电脑，我想帮我一个忙，如果有问题的话，按下每个类别的不同单元格(A =坏了的电机，B=管道系统的泄漏，等等)。改变它的颜色。

如果没有问题，索引-颜色是绿色，如果有问题，它的红色(暗红色)。

现在，我已经运行了以下VBA-脚本，它向每个单元格中添加一个单元格值1，并通过数据格式“；”我将其隐藏起来，以免其可见，并切换颜色：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Not Intersect(Target, Range("D13:O148")) Is Nothing Then
Select Case Target.Interior.ColorIndex
Case xlNone, 4: Target.Interior.ColorIndex = 53
         Target.Cells.Value = 1
    Case Else: Target.Interior.ColorIndex = 53
        Target.Cells.Value = 1
End Select
End If
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("D13:O148")) Is Nothing Then
        Cancel = True
        Target.Interior.ColorIndex = 43
        Target.Cells.ClearContents
    End If
End Sub

(我使用了来自堆栈溢出的网络资源，并对其进行了修改，因此，如果有人看到他的脚本而感到不快，对此我表示歉意)。

如果我按一个单元格，我可以将它标记为缺陷(红色)，给它1的cells.value，并在顶部加起来。如果我右击一个细胞，我就可以清除它。

现在的问题是：

​

​

因为每个窗口/对角器都有自己的特定数目(总共31层楼)。顺便说一句，我们必须为我们的办公室把每个窗口/卷积器写在一起，这样我们的分包商就可以看到哪一个会议/窗口有问题，从每个人所拥有的标签中，他知道该在哪里工作，以及诊断出了什么问题。

因此，为了使它更短:如果我单击一个单元格，改变它的颜色并添加它的值，我想得到窗口/Convector，并将它写入到A (B4)旁边的单元格中，就像您在图片中看到的那样。我也想对表格中的每一个错误字母做同样的处理。这里有一个小例子，我的意思是：

-Lets称卷积器nr.8电机坏了(A)，管子漏了(B)。。

-I按下表行中的单元格A和B，以便进行windownr。8并将其标记为红色(+它得到隐藏值1)

A和B的-Summary每上升1

-It将窗口号"8“添加到顶部的A-和B-单元中

-If更多的对流器在那层有这个问题，它会在彼此之后添加它们(如果7也是缺陷，它看起来是这样的：\{##**$}{##**$}}

这样，我们可以：

-Summarize成本并通知客户一切的价格(每个问题都有固定的成本)

-Our分包商可以与我的同事一起独立工作，而不需要我和他们一起工作(我们今年在每个会议上都贴了标签)。

如果出现问题，-Faster和在今年晚些时候更容易维护和查找

-Our办公室终于可以关闭…… hust 对此保持安静。

因此，如果有这样的问题，并有一个很好的想法，我可以写在VBA，而不必手动添加到列表中，我将非常感激。

Answer 1

我建议您不要使用VBA为单元格着色，而是使用条件格式。那就容易多了。使用您的代码将一个数字输入到您所触摸的单元格中，或者删除它。然后使用工作表公式计算总数，并对填充颜色使用条件格式。这样你就不会用VBA改变颜色了。

对于每个单元格的更改，您都希望更新顶部的表，以显示用该类别字母标记的逗号分隔的行号列表。您可以使用只监视数据输入单元格的change事件，然后逐列遍历所有数据行。如果当前单元格的值为1，则将行的楼层号附加到顶部的汇总表中。

摘要表的布局与数据输入布局不同，因此需要一些额外的代码来标识要向哪个单元格写入结果。

下面是我在代码中使用的类似布局。

​

​

每当输入表中的值被更改时，此工作表更改事件重新计算汇总表中的值。您需要调整此代码以反映您的工作表目标行和列，但是注释应该会帮助您解决这个问题。

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B7:G12")) Is Nothing Then
    mytargetrow = 1
    Application.EnableEvents = False
    Range("B1:B3").ClearContents
    Range("D1:D3").ClearContents
    For i = 1 To 6 ' this is for six columns of data
        For j = 1 To 6 ' this is for six rows of data
            myrow = j + 6 ' adjust to the number of rows above the first row of data
            mycolumn = i + 1 ' adjust to the number of columns to the left of the A data column
            If Cells(myrow, mycolumn) = 1 Then
                ' find the target cell
                ' the arrangement of the summary table is different
                ' and the summary table is in several columns
                If i <= 3 Then
                    mytargetcolumn = 2
                Else
                    mytargetcolumn = 4
                End If
                If mytargetrow = 4 Then mytargetrow = 1 ' start in row 1 for the second column of the summary table
                If Len(Cells(mytargetrow, mytargetcolumn)) > 0 Then ' if the cell already has a value
                ' write the floor number from column A in the current row.
                    Cells(mytargetrow, mytargetcolumn) = Cells(mytargetrow, mytargetcolumn) & ", " & Cells(myrow, 1)
                Else
                     Cells(mytargetrow, mytargetcolumn) = Cells(myrow, 1)
                End If
            End If
        Next j
        mytargetrow = mytargetrow + 1
    Next i
    Application.EnableEvents = True
End If
End Sub