Question

我有一个包含10列数据的电子表格（超过100,000行）。其中两列使用逗号分隔值条目。我需要一个宏（或一系列宏）或VBA脚本，它们可以自动复制现有的数据行，但每个这样的逗号分隔值条目只有一个条目。

所以今天我有一行，A-D列：

  A      B        C                       D
John | Smith | Virginia | Apples, Bananas, Grapes, Mangoes

我想要：

  A      B        C         D
John | Smith | Virginia | Apples  
John | Smith | Virginia | Bananas  
John | Smith | Virginia | Grapes  
John | Smith | Virginia | Mangoes

我需要宏“足够智能”才能为CSV单元格中的条目数创建重复行。所以，在我的例子中，我有4个水果名称。如果我有17个水果名称，我想要17行，每行有一个水果的单个实例。如果有两个相同的水果名称，那没关系 - 我可以使用相同水果名称的两个重复行。

关于如何实现这一目标的建议？我试图将文本解析为列，但对宏编程知之甚少。

Answer 1

对于踢球，这里是重复删除

将数据从A:D转换为E:H

enter image description here

Sub SliceNDice()
    Dim objRegex As Object
    Dim X
    Dim Y
    Dim lngRow As Long
    Dim lngCnt As Long
    Dim tempArr() As String
    Dim strArr
    Set objRegex = CreateObject("vbscript.regexp")
    objRegex.Pattern = "^\s+(.+?)$"
     'Define the range to be analysed
    X = Range([a1], Cells(Rows.Count, "d").End(xlUp)).Value2
    ReDim Y(1 To 4, 1 To 1000)
    For lngRow = 1 To UBound(X, 1)
         'Split each string by ","
        tempArr = Split(X(lngRow, 4), ",")
        For Each strArr In tempArr
            lngCnt = lngCnt + 1
             'Add another 1000 records to resorted array every 1000 records
            If lngCnt Mod 1000 = 0 Then ReDim Preserve Y(1 To 4, 1 To lngCnt + 1000)
            Y(1, lngCnt) = X(lngRow, 1)
            Y(2, lngCnt) = X(lngRow, 2)
            Y(3, lngCnt) = X(lngRow, 3)
            Y(4, lngCnt) = objRegex.Replace(strArr, "$1")
        Next
    Next lngRow
     'Dump the re-ordered range to columns E:H
    [e1].Resize(lngCnt, 4).Value2 = Application.Transpose(Y)
    ActiveSheet.Range("E:H").RemoveDuplicates Columns:=Array(1, 2, 3, 4), _
        Header:=xlNo
End Sub

Answer 2

不适用于积分。

由于我手上有一些时间，我想演示上面其他人说的话。但是，我会再添加一点。但请注意，@ brettdj的代码比这要好得多，但至少这个更简单，如果完全不能解决100,000行（ ，我个人留给你 ）。

逻辑：

我们使用,作为分隔符拆分字符串。我们将结果存储到数组中。

我们调用字典并仅使用它来存储唯一值。我们也修剪了数组中的字符串。

然后，我们使用非常简单的动作将您的行复制的次数等于现在存储在字典中的独特水果的数量。这将为我们提供足够的空间来发布新的水果清单。

我们将字典内容转置到已调整大小的原始位置。

<强>代码：

Sub FruitNinja() Dim FrootWhere As Range, Dict As Object Dim Frooty As String, Froots() As String Set FrootWhere = Range("D1") Frooty = FrootWhere.Value Froots = Split(Frooty, ",") Set Dict = CreateObject("Scripting.Dictionary") For i = LBound(Froots) To UBound(Froots) If Not Dict.Exists(Froots(i)) Then Dict.Add Trim(Froots(i)), Empty End If Next i FrootWhere.EntireRow.Copy Cells(FrootWhere.Row + 1, 1).Resize(Dict.Count - 1, 1).EntireRow.Insert FrootWhere.Resize(Dict.Count, 1).Value = Application.Transpose(Dict.Keys) Set FrootWhere = Nothing Set Dict = Nothing Application.CutCopyMode = False End Sub

设置向上：

<强>结果：

我的方法的概念实际上非常简单。我给你的数据做的方式，如果没有使用上面的更好的答案，就是将一个范围传递给这个子，你有多少相关的范围。基本上，我将从另一个子系统中调用它。

这段代码的优点是它很容易检查，调试，修改和操作。这样做的缺点是，对于大量的行来说它会很慢，它可能会以最奇怪的方式出错，并且在很多条件下很难维护。

希望这会对你有所帮助。：）

Excel宏或VBA脚本将CSV单元格数据转换为行

2 个答案: