Question

我的宏中有一些代码，它为工作表“Main”中的列（A）中的每个唯一值创建一个新工作表。它现在工作正常。

Dim rLNColumn As Range
Dim rCell As Range
Dim sh As Worksheet
Dim shDest As Worksheet
Dim rNext As Range


Const sLNHEADER As String = "CUSIP"


Set sh = Sheets("Main")
Set rLNColumn = sh.UsedRange.Find(sLNHEADER, , xlValues, xlWhole)


'Make sure you found something
If Not rLNColumn Is Nothing Then
    'Go through each cell in the column
    For Each rCell In Intersect(rLNColumn.EntireColumn, sh.UsedRange).Cells
        'skip the header and empty cells
        If Not IsEmpty(rCell.Value) And rCell.Address <> rLNColumn.Address Then
            'see if a sheet already exists
            On Error Resume Next
                Set shDest = sh.Parent.Sheets(rCell.Value)
            On Error GoTo 0


            'if it doesn't exist, make it
            If shDest Is Nothing Then
                Set shDest = sh.Parent.Worksheets.Add
                shDest.Name = rCell.Value
                shDest.Range("A1").FormulaR1C1 = "CUSIP"
                shDest.Range("B1").FormulaR1C1 = "Security"
                shDest.Range("C1").FormulaR1C1 = "Broker"
                shDest.Range("D1").FormulaR1C1 = "Shares"
                shDest.Range("E1").FormulaR1C1 = "Debit"
                shDest.Range("F1").FormulaR1C1 = "Credit"
                shDest.Range("G1").FormulaR1C1 = "Account"
                shDest.Range("H1").FormulaR1C1 = "Description"
                shDest.Range("I1").FormulaR1C1 = "Comments"
                shDest.Range("J1").FormulaR1C1 = "Process"
                shDest.Range("K1").FormulaR1C1 = "Origin"
                shDest.Range("L1").FormulaR1C1 = "Net Qty"
                shDest.Range("M1").FormulaR1C1 = "Net Amt"
            End If


            'Find the next available row
            Set rNext = shDest.Cells(shDest.Rows.Count, 1).End(xlUp).Offset(1, 0)

            'Copy and paste
            Intersect(rCell.EntireRow, sh.UsedRange).Copy rNext


            'reset the destination sheet
            Set shDest = Nothing
        End If
    Next rCell
End If

现在，我意识到我不需要WS“Main”中只有1行与之关联的唯一值。我如何在此代码中反映出来？某种IF语句要说，如果A列中只有这个唯一值的1个实例，则不要用它创建新的工作表。

此外，对于创建的每个工作表，每行都指定为借方或贷方。我可以在工作表上保留借方，但我需要获取贷记并转到另一个工作表...

我无法编写代码来引用每个新工作表，因为它并不总是相同。

澄清：

假设在A列（“CUSIP”）中，有3个唯一值（A，B，C），每个值都有2行。 1行将在E列中具有值（“借记”），1行将在F列中具有值（“信用”）。在创建每个唯一的值表后，每个2行，我需要通过借方和贷方分隔每个工作表（所以基本上取信用行并将其移动到新工作表，每个唯一值）。

第二部分 - A列中的值对于我运行此宏的每个报表都不相同，因此我无法按名称甚至位置引用特定的工作表。

Answer 1

您可以使用WorksheetFunction CountIf（see this）。

我会将其插入您的代码中（未经测试）：

If Not IsEmpty(rCell.Value) And rCell.Address <> rLNColumn.Address Then
    'Check for multiple values.
    If WorksheetFunction.CountIf(sh.Range("A:A"), rCell.Value) > 1 Then
        'see if a sheet already exists
        On Error Resume Next
            Set shDest = sh.Parent.Sheets(rCell.Value)
        On Error GoTo 0
        '. . .

不要忘记关闭额外的If声明！

对于列中的每个唯一值，创建一个新工作表+更多

1 个答案: