Excel 在值超过 15 个实例后向重复值添加一个字符的宏

Question

目前在 excel 2010 年运营

我正在构建一个宏来格式化各种报告，以便 excel 工作表可以输入到自动加载工具中。此宏为每个案例添加一个唯一的数字标识符，然后根据正在执行的服务量将案例分成多行。因此，最初案例将在 A 列中编号为 1、2、3、4 等。然后根据服务数量将个案分成多行，A 列中的数字用于对服务进行分组。因此，如果案例一有 3 项服务，案例二有 1 项服务，案例三有 5 项服务，则 A 列看起来像 1,1,1,2,3,3,3,3,3 降序。

自动加载工具每个案例仅构建 15 行。所以我需要添加代码来搜索 A 列，如果重复值超过 15 个实例，则将 "a" 添加到前 15 个实例，将 "b" 添加到第二个 15 个实例，将 "c" 到第三个 15 实例，依此类推。

示例：

在A列desending中：如果标识符看起来像1,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3, 3,4 然后宏会将 A 列更新为如下所示：1,2,3a,3a,3a,3a,3a,3a,3a,3a,3a,3a,3a,3a,3a,3a,3a,3b,3b,4

感谢您的宝贵时间

这是我到目前为止所编写的代码：

Sub Scrub_File()      
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
    range("A2").Select
    ActiveCell.FormulaR1C1 = "1"
       LastRow = range("K" & Rows.Count).End(xlUp).Row
        range("A2").AutoFill Destination:=range("A2:A" & LastRow),   Type:=xlFillSeries
Dim InxSplit As Long
  Dim SplitCell() As String
  Dim RowCrnt As Long
  With Worksheets("Sheet1")
    RowCrnt = 2         ' The first row containing data.
    Do While True
      If .Cells(RowCrnt, "AI").Value = "End" Then
        Exit Do
      End If
      SplitCell = Split(.Cells(RowCrnt, "AI").Value, ",")
      If UBound(SplitCell) > 0 Then
        .Cells(RowCrnt, "AI").Value = SplitCell(0)
        For InxSplit = 1 To UBound(SplitCell)
          RowCrnt = RowCrnt + 1
          .Cells(RowCrnt, "AI").Value = SplitCell(InxSplit)
        .range(.Cells(RowCrnt, "A"), .Cells(RowCrnt, "AH")).Value = .range(.Cells(RowCrnt - 1, "A"), .Cells(RowCrnt - 1, "AH")).Value
        .range(.Cells(RowCrnt, "AL"), .Cells(RowCrnt, "AX")).Value = .range(.Cells(RowCrnt - 1, "AL"), .Cells(RowCrnt - 1, "AX")).Value
        Next
        End If
      RowCrnt = RowCrnt + 1
    Loop
  End With
End Sub

Answer 1

对于 Excel 公式，您可以使用：

=IF(COUNTIF($A:$A,A3)>15,  A3&CHAR(96+INT( (COUNTIF($A:A3,A3)-1)/15+1)),A3)

您的 ID 代码在 A 列中，例如从 A3.

开始

对于 VBA 宏，在您填充 ID 列后成为运行：

Option Explicit
Sub markDups()
    Dim WB As Workbook, WS As Worksheet
    Dim rID As Range, C As Range, D As Range
    Dim lcntID As Long, lposCnt As Long

Set WB = ThisWorkbook
Set WS = WB.Worksheets("sheet1")
With WS
    Set rID = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp)) 'alter as needed
End With

For Each C In rID
    Set D = C.Offset(0, 1) 'remove offset to overwrite
    lcntID = WorksheetFunction.CountIf(rID, C.Value2)
    If lcntID > 15 Then
        Set D = C.Offset(0, 1) 'remove offset to overwrite
        lposCnt = WorksheetFunction.CountIf(Range(rID(1, 1), C), C)
        D = C.Value2 & Chr((lposCnt - 1) \ 15 + 97)
    Else
        D = C.Value2
    End If
Next C

End Sub

Excel 在值超过 15 个实例后向重复值添加一个字符的宏

Excel Macro to add a character to duplicate values after the value exceeds 15 instances

excel

vba

excel-formula

excel-2010