Question

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

总体而言，我想找到一个范围不等于0的单元格（在该单元格范围内为0或1）并复制该列的标题并将其粘贴到它找到1的同一行的L单元格中。

所以它是这样的：

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

EX：

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

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

Cell L4中的数字4会像这样输出（苹果，香蕉）
Cell L5中的数字5会像这样输出（Tomatoes）
单元格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

希望这有帮助

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

1 个答案: