Question

所以我编写了一个VBA代码来计算某些输入数据的每个标题下的空白，非空白和总条目数。我想添加一个代码，将值从一个工作表复制并粘贴到另一个工作表，重复数据删除值，给出每个标题下唯一值的唯一值列表，唯一值的数量以及这些值下的唯一值的发生次数。头。

空白：我之前使用过countblank函数，但它会跳过某些空字段，因此我将其更改为sumproduct(len(Range)=0)*1)。非空白：我写了一个类似的功能，并尝试计算上述内容。

事实证明VBA无法处理Sumproduct功能。以下是我尝试过的方法：

 1. Application.WorksheetFunction.Sumproduct(...)
 2. ..Number.. = "=Sumproduct(...)"
 3. ..Number.. = Evaluate("Sumproduct(...)")
 4. ..Number.. = Worksheet.Evaluate("Sumproduct(...)")

下面是宏的代码，我在Input_File上编写代码，即输入工作表。

Sub Dedupe()
ThisWorkbook.Worksheets("Control_Totals").Cells.ClearContents

Dim lRow As Long
Dim lCol As Long
Dim i As Long
Dim j As Long
Dim Input_File As Worksheet
Dim Output_File As Worksheet
Dim Dedup_File As Worksheet
Dim Col_Let As String
Dim Rng As String
Dim blank As String
Dim non_blank As String

Set Input_File = ThisWorkbook.Worksheets("Input")
Set Output_File = ThisWorkbook.Worksheets("Control_Totals")
Set Dedup_File = ThisWorkbook.Worksheets("Deduped")

With Output_File
        .Cells(1, 1) = "Field_Name"
        .Cells(1, 2) = "Blanks"
        .Cells(1, 3) = "Non-Blanks"
        .Cells(1, 4) = "Total"
End With

'Finding the last row among all entries, including the blank ones
lRow = Input_File.Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row

MsgBox "Last Row: " & lRow

'Finding the last column header/field
lCol = Input_File.Cells.Find(What:="*", _
                  LookAt:=xlPart, _
                  LookIn:=xlFormulas, _
                  SearchOrder:=xlByColumns, _
                  SearchDirection:=xlPrevious, _
                  MatchCase:=False).Column

MsgBox "Last Column: " & lCol

i = 1

'Finding the number of blank and non-blank entries for all the fields
Do While i < lCol + 1
Col_Let = ColumnLetter(i)
Rng = "Input!" & "Col_Let" & "2" & ":" & "lRow"


    Output_File.Cells(i + 1, 1) = Input_File.Cells(1, i)

         blank = "SumProduct((Len(Rng) = 0) * 1)"
         non_blank = "SumProduct((Len(Rng) > 0) * 1)"

    Output_File.Cells(i + 1, 2).Value = Evaluate(blank)
    Output_File.Cells(i + 1, 3).Value = Evaluate(non_blank)
    Output_File.Cells(i + 1, 4) = lRow - 1


    'Deduping the data under the headers
    j = 0
    For j = 1 To lRow
    Dedup_File.Cells(j, i).Value = Input_File.Cells(j, i).Value
    j = j + 1
    Next
    Dedup_File.Range(Cells(1, i), Cells(lRow, i)).RemoveDuplicates Columns:=1, _ 
    Header:=xlYes

        i = i + 1

Loop

End Sub

Answer 1

这些行没有做你认为他们做的事情

Col_Let = ColumnLetter(i)
Rng = "Input!" & "Col_Let" & "2" & ":" & "lRow"

Rng始终是一个字符串，包含＆＃34;输入！Col_Let2：lRow＆＃34;

你的意思是:(我认为） Rng =＆＃34;输入！＆＃34; ＆安培; Col_Let＆amp; ＆＃34; 2＆＃34; ＆安培; ＆＃34;：＆＃34; ＆安培; Col_Let＆amp; lRow

其次Rng仅存在于此vba例程中 - 它对Excel没有任何意义，因此您无法在Excel公式中使用它。你需要

blank = "SumProduct((Len(" & Rng.address & ") = 0) * 1)"

最后SumProduct不喜欢VBA中的那些技巧（它依赖于excel将1自动扩展到数组中）。更好的解决方案：

Dim cBlank as long
Dim cNonBlank as long
Dim r as range
For each r in rng
if r.text = "" then 
   cBlank= cBlank+1
else 
   cNonBlank = cNonBlank +1
 end if
 next r

Answer 2

我想添加一个代码，用于将值从一个工作表复制并粘贴到另一个工作表，重复数据删除值，为每个标题下的唯一值列表提供唯一值的唯一列表，以及这些值的次数标题下会出现唯一值。

您刚才描述的是一个数据透视表，其中“行”区域和“值”区域中的感兴趣字段为“计数”。

Excel VBA - 评估函数返回#NAME？错误

2 个答案: