在值超过15个实例后添加字符以重复值的Excel宏
在值超过15个实例后添加字符以重复值的Excel宏
提问于 2019-09-26 00:42:59
当前在excel 2010中运行
我正在构建一个宏来格式化各种报告，以便excel工作表可以输入到自动加载工具中。此宏为每个案例添加一个唯一的编号标识符，然后根据所执行的服务量将案例分解为多行。因此，最初案例将在A列中编号为1、2、3、4等。然后，根据服务的数量将案例拆分成多行，并使用A列中的数字对服务进行分组。因此，如果第一个案例有3个服务，第二个案例有1个服务，第三个案例有5个服务，A列将看起来是1,1,1,2,3,3,3,3,3，3，3，3，3，3。
自动加载工具仅为每个案例构建15行代码。因此，我需要添加代码来搜索列A，如果重复值超过15个实例，则将"a“添加到前15个实例，将a "b”添加到第二个15个实例，将a "c“添加到第三个15个实例，依此类推。
示例：
在A列中降序:如果标识符看起来像1，2，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回答 1
Stack Overflow用户
回答已采纳
发布于 2019-09-26 09:43:30
对于Excel公式，您可以使用：
=IF(COUNTIF($A:$A,A3)>15, A3&CHAR(96+INT( (COUNTIF($A$3: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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/58103032
复制相关文章
相似问题
腾讯云开发者
