Excel VBA查找不等于0的数据并复制行标头

Question

我有一个电子表格，我需要为它创建一个宏，我需要你们的帮助。

总的来说，我想在不等于0的范围内找到一个单元格(该单元格范围内为0或1)复制该列的标题，并将其粘贴到找到1的同一行的L单元格中。

所以它是这样的：

行N2至WI2具有列的标题，范围N3到WI9000是具有1或0--1(如果值存在)和0(如果未找到)的单元格的位置

例如：

3   Apples Bananas Tomatoes
4        1       1        0
5        0       0        1
6        1       0        0

当它看到1或不等于0时：

• L4细胞中的4号细胞会像这样输出(苹果、香蕉)
• L5细胞中的5号细胞会这样输出(番茄)
• 单元格L6中的数字6会像这样输出(苹果)

感谢的帮助

Answer 1

像这样做老派↓↓↓或使用range.findnext(previousfind)

Sub FruitSorter()
Dim xrow As Long
Dim xcolumn As Long
Dim lastcolumn As Long
'dont forget to use cleaner - (desired)range.ClearContents before running this
xrow = 4 'seen in example edit this
xcolumn = 1 'seen in example edit this
lastcolumn = 4 'your last column where you want the fruit to be written into
Do 'loop for rows
Do 'loop for columns
Select Case Cells(xrow, xcolumn).Value 'checks if cell contains 1
Case 1 'if one do below
If Cells(xrow, lastcolumn) = "" Then 'if it is first time the cell is modified then
Cells(xrow, lastcolumn) = Cells(3, xcolumn).Value 'write data
Else 'if the cell already contains fruit then
Cells(xrow, lastcolumn) = Cells(xrow, lastcolumn) & ", " & Cells(3, xcolumn).Value 'insert value thet already is in the cell plus the new one
End If
Case 0 'nothing happens
End Select
xrow = xrow + 1 'move one row forward
Loop Until Cells(xrow, xcolumn) = "" 'will loop until cell under your table is empty you can set any other specified condition like row number(until xrow=200)
xcolumn = xcolumn + 1  'move one column forward
xrow = 4 'move back to the beginning
Loop Until xcolumn = lastcolumn 'will loop until xcolumn reaches the last column where fruit is being written
End Sub

希望这能帮助