VBA清理行的有条件重复

Question

我有一个数据集，其中有一个id字段和许多其他字段。

id字段有时会有第二个id。在这种情况下，我需要创建一个新的重复记录，并在每个记录中放置一个id。还有一个附加条件，其中每个id后面可以跟一个百分比的数字。在所有情况下，我都需要在记录的字段中显示正确的百分比作为小数值。

id示例：

AJ01-25/ST01-75
AJ01/LM03
RICH01

正确表示ID和百分比：

id      percent
AJ01    .25
ST01    .75
AJ01    .5
LM03    .5
RICH01  1.0

我使用以下代码创建新记录，并在检测到“/”时将任何百分比解析为新字段，但我非常希望有更清洁的东西。排序顺序无关紧要（我的脚本在最后放置新记录）。想法？

Sub breakemup()
Dim wb As Workbook
Dim ws As Worksheet
Dim id As String
Dim rng As Range
Dim ar() As String

Set wb = ThisWorkbook
Set ws = wb.Worksheets("data")

Dim currentRow As Integer
Dim finalRow As Integer
finalRow = ws.UsedRange.Rows.Count
For currentRow = 2 To finalRow
    ar() = Split(ws.Range("a" & currentRow).Value, "/")
    If UBound(ar) = 1 Then
        ws.Rows(currentRow).Copy Destination:=ws.Range("A" & Rows.Count).End(xlUp).Offset(1)
        If UBound(Split(ar(1), "-")) = 1 Then
            ws.Range("A" & Rows.Count).End(xlUp).Value = Split(ar(1), "-")(0)
            ws.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = CDbl(Split(ar(1), "-")(1)) / 100#
            ws.Range("A" & currentRow).Value = Split(ar(0), "-")(0)
            ws.Range("A" & currentRow).Offset(0, 1).Value = CDbl(Split(ar(0), "-")(1)) / 100#
        Else
            ws.Range("A" & Rows.Count).End(xlUp).Value = ar(1)
            ws.Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = 50 / 100#
            ws.Range("A" & currentRow).Value = ar(0)
            ws.Range("A" & currentRow).Offset(0, 1).Value = 50 / 100#
        End If
    Else
        ws.Range("A" & currentRow).Offset(0, 1).Value = 1#

    End If
Next

End Sub

Answer 1

不确定您是否会考虑这种清洁剂，但这是一个公式解决方案而不是VBA解决方案。它使用以下功能：

1. INDIRECT
2. MID
3. LEN
4. IF
5. RIGHT
6. 查找

假设我们在表1中有以下内容：



在表2中插入以下公式：

单元格A2：

= IF（E2 = 1，IF（D2 =“”，IF（C2 =“”，间接（G2），左（间接（G2），C2-1）），左（间接（G2），D2 -1）），IF（D2 =“”，IF（C1 =“”，间接（G2），右（间接（G2），LEN（间接（G2）） - C1）），MID（间接（G2）， C1 + 1，D2 -1-C1）））

向下拖动/复制以覆盖A列中的其余单元格

单元格B2：

= IF（E2 = 1，IF（C2 = “”，IF（D2 = “”，1，MID（INDIRECT（G2），C2 + 1，LEN（INDIRECT（G2）））），IF（D2 =“”，0.5，MID（间接（G2），D2 + 1，C2-D2-1）/ 100）），IF（D2 =“”，0.5，MID（间接（G2），D2 + 1，LEN（ INDIRECT（G2）） - D 2）/ 100））

将其向下拖动/复制以覆盖B列中的其余单元格

单元格C2：

= IF（E2 = 1，IF（ISNUMBER（FIND（“/”，INDIRECT（G2））），FIND（“/”，INDIRECT（G2）），“”），“”）

向下拖动/复制以覆盖C列中的其余单元格

细胞D2：

= IF（E2 = 1，IF（ISNUMBER（FIND（“ - ”，INDIRECT（G2））），FIND（“ - ”，间接（G2）），“”），IF（D1 =“”， “”，查找（“ - ”，间接（G2），D1 + 1）））

向下拖动/复制以覆盖D列中的其余单元格

细胞E2：

数字值“1”

单元格E3：

= IF（E2 = 1，IF（C2 =“”，1,2），1）

将其向下拖动/复制以覆盖E列中的其余单元格

Cell F2：

数字值“1”

单元格F3：

= IF（E3 = 1，F2 + 1，F2）

将其向下拖动/复制以覆盖F列中的其余单元格

Cell G2：

=“Sheet1！A”＆amp;文字（F2,0）

将其向下拖动/复制以覆盖G列中的其余单元格

<强>结果：



您可以隐藏额外的列，这样您只能看到所需的列：



我的博客上有一篇文章提供了一个与此处使用的函数几乎完全相同的示例，它可能有助于理解所使用的函数Excel Functions and Formulas Sample #1, Split Strings Based on Delimeter