Question

我在下面有一个代码的工作示例，它将数据从一个工作簿复制到另一个工作簿。它检查“FROM”工作簿的C列中的值，并计算C列中的不同唯一值，并在第二个工作簿单元格中输出该计数/值。

到目前为止一切顺利。

我的问题是，我一直在尝试调整下面的代码以查看列F，检查值是否等于特定条件，然后仅计算列C中具有该列中的cirteria的项目。

Sub CopyDataFromSourceFile()

Dim wbFrom As Workbook
Dim wbTo As Workbook
Dim Listcount As String
Dim LstRw As Long, Rng As Range, List As Object

LstRw = Cells(Rows.Count, "C").End(xlUp).Row
Set List = CreateObject("Scripting.Dictionary")

For Each Rng In Range("C9:C" & LstRw)
  If Not List.Exists(Rng.Value) Then List.Add Rng.Value, Nothing
Next

'MsgBox "There are " & List.Count & " unique values"

Listcount = List.Count


wbFrom.Sheets("Sheet1").Range("B3").Copy

wbTo.Sheets("Sheet1").Range("A1").PasteSpecial
wbTo.Sheets("Sheet1").Range("D4").Value = Listcount

wbTo.Activate


End Sub

一些数据：

1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30340
1900 CUMBERLAND PKWY SE ATLANTA GA  30341
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1900 CUMBERLAND PKWY SE ATLANTA GA  30339
1901 CUMBERLAND PKWY SE     GA  30340
1902 CUMBERLAND PKWY SE     GA  30341

请注意地址和邮政编码的更改。当且仅当邮政编码等于30339时，我想计算C列中的唯一值（唯一的地址计数）。

因此，上述示例的最终结果应该是16条记录中的12条。

Answer 1

添加支票30339：

For Each Rng In Range("C9:C" & LstRw)
  If Rng.Offset(0,3) = 30339 Then
    If Not List.Exists(Rng.Value) Then List.Add Rng.Value, Nothing
  End If
Next

奖励提示加快速度：在构建字典之前，将Range(C9:F & LstRw)作为变量数组读取（请参阅http://www.cpearson.com/excel/ArraysAndRanges.aspx）。

Excel VBA - 根据B列中的条件计算A列中的唯一/不同值

1 个答案: