从一列生成一个包含两列的表格

Question

我需要宏在工作表 A 中查找包含值的特定列，并在工作表 B 的特定位置中的现有工作表 B 中生成一个包含两列的表格，第一列包含在该列中找到的值（不重复），第二列为包含对应值计数的列

我尝试了这个宏，但收到错误消息

“基本运行时错误。未找到属性或方法：setValue。”

Sub GenerateUniqueValueTable()
    Dim oSheetA As Object
    Dim oSheetB As Object
    Dim oSourceRange As Object
    Dim oTargetRange As Object
    Dim oUniqueValues As Object
    Dim oCell As Object
    Dim i As Long

    ' Set the source sheet (Sheet A) and source range (adjust as needed)
    oSheetA = ThisComponent.getSheets().getByName("BD-direta")  
    oSourceRange = oSheetA.getCellRangeByName("P1:P2047")

    ' Set the target sheet (Sheet B) and target range (adjust location as needed)
    oSheetB = ThisComponent.Sheets.getByName("Estatistica") 
    oTargetRange = oSheetB.getCellRangeByName("B64:C64")  

    ' Create a new table header
    oTargetRange.setValue("Unique Value")
    oTargetRange.getCellByPosition(1, 0).setString("Count")

    ' Get unique values and their counts
    oUniqueValues = CreateUnoService("com.sun.star.container.UniqueElementsContainer")
    For Each oCell In oSourceRange
        If Not oUniqueValues.has(oCell.String) Then
            oUniqueValues.insert(oCell.String, 1)
        Else
            oUniqueValues.replaceByIndex(oUniqueValues.indexOf(oCell.String), oUniqueValues.getByIndex(oUniqueValues.indexOf(oCell.String)) + 1)
        End If
    Next

    ' Populate the target sheet
    For i = 0 To oUniqueValues.getCount() - 1
        oSheetB.getCellByPosition(2, i + 1).setString(oUniqueValues.getByIndex(i))
        oSheetB.getCellByPosition(3, i + 1).setValue(oUniqueValues.getByIndex(i))
    Next
End Sub

Answer 1

事实上，“单元格范围”对象上没有

setValue()

方法，这只适用于单个单元格。

但这并不是此代码不起作用的唯一原因。 要将字符串“Unique Value”写入单元格，请使用

setString()

方法而不是

setValue()

，后者旨在写入数值。

执行一行

oUniqueValues = CreateUnoService("com.sun.star.container.UniqueElementsContainer")

注定要失败 - 模块 com.sun.star.container 中没有 UniqueElementsContainer 接口。因此，您必须自己编写代码来计算唯一值。可能类似于这样：

Sub countUnique(key As Variant, aData As Variant)
Dim l&, r&, m&, N&, i&
    l = LBound(aData)
    r = UBound(aData) + 1
    N = r
    While (l < r) 
        m = l + Int((r - l) / 2)
        If aData(m)(0) < key Then l = m + 1 Else r = m
    Wend
    If r = N Then
        ReDim Preserve aData(0 To N)
        aData(N) = Array(key, 1)
    ElseIf aData(r)(0) = key Then
        aData(r)(1) = aData(r)(1) + 1
    Else
        ReDim Preserve aData(0 To N)
        For i = N - 1 To r Step -1
            aData(i + 1) = aData(i)
        Next i
        aData(r) = Array(key, 1)
    End If
End Sub

对于不是很大的数据集（七到一万个值），这将很快起作用。

现在执行该任务的宏可能如下所示：

Sub GenerateUniqueValueTable()
Dim oSheets As Object, oSheetA As Object, oSheetB As Object
Dim oSourceRange As Object, aData As Variant, aUniqueValues() As Variant
Dim oTargetRange As Object
Dim i As Long
    oSheets = ThisComponent.getSheets()
    ' Set the source sheet (Sheet A) and source range (adjust as needed)
    oSheetA = oSheets.getByName("BD-direta")  
    oSourceRange = oSheetA.getCellRangeByName("P1:P2047")

    ' Set the target sheet (Sheet B) and target range (adjust location as needed)
    oSheetB = oSheets.getByName("Estatistica") 

    ' Create a new table header
    oSheetB.getCellRangeByName("B64").setString("Unique Value")
    oSheetB.getCellRangeByName("C64").setString("Count")

    ' Get unique values and their counts
    aData = oSourceRange.getDataArray()
    For i = LBound(aData) To UBound(aData)
        Call countUnique(aData(i)(0), aUniqueValues)
    Next

    ' Populate the target sheet
    oTargetRange = oSheetB.getCellRangeByPosition(1, 64, 2, 64+UBound(aUniqueValues))
    oTargetRange.setDataArray(aUniqueValues)
End Sub

我知道您的问题与编写宏具体相关。但是，我不得不说，如果您要向“BD-direta”.P1 单元格中的数据添加某种数据标头（如键），则只需使用 Pivot 单击几下即可获得相同的结果表