Excel在表VBA中返回非零值的行和列标题

我有一堆零和值的表。 我想编写一个代码，通过表格中的每个单元格，当一个单元格具有非零值时，macros将列出每个非零单元格的行和列名称。

Kroger Meijer Wholefoods Walmart Food 0 0 0 1 Food, Walmart Electronics 0 1 0 1 Electronics, Meijer; Electronics Walmart Gas 0 0 1 0 Gas, Wholefoods Crafts 0 1 0 0 Crafts, Meijer 

在代码方面，除了select所有非零的单元之外，我并不知道如何做到这一点。

 Sheets("NA_CM1").Select ActiveSheet.ListObjects("ItI_COMPLETE_NACM1").Range.Select For Each cell In Range("ItI_COMPLETE_NACM1") If cell.Value <> 0 Then If my_range Is Nothing Then Set my_range = cell Else Set my_range = Union(my_range, cell) End If End If 

Answer 1

一个可能的非VBA解决scheme将涉及使用一个反转透视来扁平化您的交叉表数据，然后过滤哪里价值> 0.然后，您将在每个商店中的数量> 0的所有项目。

最终结果是这样的：

对于VBA解决scheme，请给这个镜头。 它根据您的示例表复制到每一行的K列。

 Sheets("NA_CM1").Select ActiveSheet.ListObjects("ItI_COMPLETE_NACM1").Range.Select For Each cell In Range("ItI_COMPLETE_NACM1") If cell.Value <> 0 Then Dim sValue As String sValue = Cells(cell.Row, 11).Value2 If Len(sValue) = 0 Then Cells(cell.Row, 11).Value = Cells(cell.Row, 1).Value2 & "," & Cells(1, cell.Column).Value2 Else Cells(cell.Row, 11).Value = sValue & "; " & Cells(cell.Row, 1).Value2 & "," & Cells(1, cell.Column).Value2 End If End If Next 

Answer 2

一个不同的解决scheme（给你一个select）:)

 Sub testing() Dim cVal As Variant, oVal() As Variant, i As Long, j As Long cVal = Sheets("NA_CM1").Range("ItI_COMPLETE_NACM1").Value ReDim oVal(1 To UBound(cVal), 1 To 1) oVal(1, 1) = cVal(1, UBound(cVal, 2)) For i = 2 To UBound(cVal) oVal(i, 1) = cVal(i, 1) & ", " For j = 2 To UBound(cVal, 2) - 1 If cVal(i, j) <> 0 Then oVal(i, 1) = oVal(i, 1) & cVal(1, j) & "; " End If Next oVal(i, 1) = Left(oVal(i, 1), Len(oVal(i, 1)) - 2) Next Sheets("NA_CM1").Range("ItI_COMPLETE_NACM1").Columns(UBound(cVal, 2)) = oVal End Sub 

它假设你的第一个例子是整个表（第1行=标题; COL 1 =头;最后COL =输出）。 所以Sheets("NA_CM1").Range("ItI_COMPLETE_NACM1").Columns(UBound(cVal, 2)) = oVal打印输出作为一个col在你的表的最后一个列（但你可以把oVal任何地方你想要的）在做大桌子的时候也应该是相当快的（如果有多于或less于4列的话，也可以使用）…我只是检查第二个到最后一个列…