Excel - 将 countif 识别的单元格导出到新文件答案

【问题标题】：Excel - Export cells identified by countif to new fileExcel - 将 countif 识别的单元格导出到新文件
【发布时间】：2015-12-22 05:47:51
【问题描述】：

我正在尝试将由 countif 识别的单元格导出到新文件。

例如，给定：

Red      dog
Blue     cat
Red      horse
Purple   bird
Red      mouse

我可以让 countif 来计算 Red 在 A 列中出现的次数。但是只有当 A 列是红色时，我才能让 excel 将 A 列和 B 列的内容写入新文件（csv？）？

所以输出是

Red    dog
Red    horse
Red    mouse

在这个例子中，我可以手动排序这个列表并复制它，但我实际的 conutif 语句（技术上是 countifs）有 4 或 5 个变量。

谢谢，阿夫拉姆

【问题讨论】：

标签： excel excel-formula vba

【解决方案1】：

可能是一个更优雅的解决方案，但这会奏效。添加一个帮助器列，该列是真还是假，具体取决于该行是否满足您的所有条件。这将生成一个类似于以下的表格

Red     Dog     TRUE
Blue    Cat     FALSE
Red     Horse   TRUE
Purple  Bird    FALSE
Red     Mouse   TRUE

然后，一个简单的宏会将具有 true 的行复制到新工作表中。根据需要进行编辑（不一定是最优雅的，但可以完成工作）

Sub copyCriteriaRange()
Dim rcounter As Integer, outputRow As Integer, dataVariant As Variant

outputRow = 1
'loop through all rows

For rcounter = 1 To 5
  'if column 3 is true, copy to a new sheet
  If Sheets("Sheet1").Cells(rcounter, 3) = True Then
     dataVariant = Sheets("Sheet1").Range("A" & rcounter & ":C" & rcounter)
     Sheets("Sheet2").Range("A" & outputRow & ":C" & outputRow) = dataVariant
     outputRow = outputRow + 1
  End If
Next

'now get rid of helper column
Sheets("Sheet2").Range("C:C").ClearContents
MsgBox "Done copying"
End Sub

然后可以使用另一个宏导出到 csv。应该很容易通过谷歌找到一个。享受吧！

【讨论】：

【解决方案2】：

对于公式：

在 A1 的另一张纸上放置所需的测试，在本例中为“红色”。在 A2 中输入这个公式：

=IF(ROW()<=COUNTIF(Sheet8!$A$1:$A$5,$A$1),$A$1,"")

并根据需要复制尽可能多的行。

在B1中放这个数组公式：

=IF(A1<>"",INDEX(Sheet8!$B$1:$B$5,LARGE(ROW($1:$5)*ISNUMBER(FIND(A1,Sheet8!$A$1:$A$5)),COUNTA($A$1:$A1))),"")

将所有Sheet8 引用更改为保存数据的工作表的名称。要扩大正在搜索的数据，请修复范围 Sheet8!$B$1:$B$5 和 Sheet8!$A$1:$A$5 以匹配大小。以及ROW($1:$5)需要包含相同行数的数据。

用Ctrl-Shift-Enter确认并向下复制。

对于可以用作函数的 UDF：

Function Avram(val As String, IRng As Range, k As Long)
Dim rng
Dim j As Long
Dim i As Long

rng = IRng.Value
j = 1
For i = LBound(rng, 1) To UBound(rng, 1)
    If rng(i, 1) = val Then
        If j = k Then
            Avram = rng(i, 2)
            Exit Function
        Else
            j = j + 1
        End If
    End If
Next i

Avram = CVErr(xlErrNA)


End Function

这将放在附加到工作簿的模块中（不是工作簿或工作表代码）

您将按照上面公式部分的说明在工作表上输入 A 列。然后在 B1 中输入：

=IFERROR(Avram(A1,Sheet8!$A$1:$B$5,COUNTA($A$1:$A1)),"")

这次唯一需要更改的是 Sheet8!$A$1:$B$5 以包含您的数据范围。这比数组公式更不挑剔，而且速度更快。

至于 Sub 来做这一切：

Sub avram2()

Dim ows As Worksheet
Dim tws As Worksheet
Dim rng
Dim Orng
Dim i As Long
Dim FndString As String

FndString = "Red" 'Change to what you want

Set ows = Sheets("Sheet8") 'Change to your sheet name with the data.
Set tws = Sheets("Sheet9") 'Change to the output sheet name

With ows
    rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(xlUp)).Value
End With
For i = LBound(rng, 1) To UBound(rng, 1)
    If rng(i, 1) = FndString Then
        tws.Cells(tws.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 2).Value = Array(rng(i, 1), rng(i, 2))
    End If
Next i

End Sub

【讨论】：