Excel VBA 根据提取的单元格值循环、复制、粘贴、偏移的宏

Question

我一直在努力为同事清理这个 csv 数据。我将浏览一下数据通常是什么样的，然后浏览一下我已经完成的步骤，然后提出我目前正在努力解决的问题……请耐心等待，因为这是我的第一个 post（并且我没有vba的背景，一切都是Google自学的）。所以数据导出是一个 csv，可以在 excel 中打开，分为几列。有问题的列是 G 列，它实际上有多个数据集 (1 – 219) 用于同一菜单项（行）。

例如：

A   B   C         D E F     G

Chicken Soup            {1;.00;59;.00;88;.00}
Beef Soup               {1;.00;59;.00;88;.00}
Duck Soup               {1;.00;59;.00;88;.00}
Egg Soup                {1;.00;59;.00;88;.00}
Water                   {1;[=12=].00}
French Onion Soup       {1;.00;59;.00;88;.00}
Chili Soup              {1;.00;84;.00}

所以在 G 列中，您可以看出，有多个价格，格式为：

{列号; $ 价格 ;列号 $ 价格等 & }

Regex: .[0-9]{1,2},[$][0-9]{1,3}[.][0-9][0-9].|[0-9]{1,2},[$][0-9]{1,3}[.][0-9][0-9]

第一个目标是将列中的数据解析为行，格式符合 csv（因此可以合并并重新提交）。例如：（假设每个数据集之间有一个分号，因为最终结果中应该有分号）

{1;.00}      
{1;.00}      
{1;.00   5;.00    8;.00}   
{1;.00   6;.00    8;.00}   
{1;.00   6;.00 9;.00    11;.00}
{1;.00   6;.00    8;.00}   
{1;.49    3;.99 10;.99    12;.99}
{1;.99}      
{1;.00}      
{1;.00}

为了实现这个目标，我写了一个宏：

从“Sheet1”复制 G 列并输入到 A1 中的新 sheet“Sheet2”
将所有“;$”替换为“,$”，以帮助将每个数据集单独分开，而不是在两个不同的列中拆分列名然后使用美元符号
文本到列宏拆分“;” （并输入结果从 B1 开始，这样我可以将 A1 和所有数据集保留在一列中，以备不时之需）——另外，如果您知道如何在此处保留分号，那将很有帮助，因此我不必重新- 以后添加
将b1到数据集末尾“,”全部替换为“;” <-- 将其恢复为原始格式
将B1的数据复制到最后一个有数据的单元格（数据不按顺序，第50行可能有219列，然后最后一行只能有150列）并将此数据粘贴到“rp项目”的G列”（因此覆盖现有数据并将列尽可能右移到使用的最后一列。

但是，当我向同事展示我所做的工作时，他希望前导数字（列号）对应于列（因为数据从 G 列开始，这将是第 1 列，H 将是 2 ETC）。因此看起来像这样，这样他就可以按具有该列号的所有项目过滤该列：

For example, this photo is how the outcome should look

所以，现在的目标是创建一个宏......

在 sheet“STEP ONE”中循环 B1:B（B 列从 B1 开始，然后是 C1，然后当该行中的空白转到下一行）
While (B1 (or next row) is blank, nothing do, end macro)
如果B1（或活动单元格）不为空，读取单元格值提取列；复制单元格的内容，将“STEP TWO”sheet 粘贴到与活动单元格相同的行中，但从单元格值中偏移列号。
切换回主要 sheet，转到该行中的下一个单元格 - 如果空白，转到下一行并重复直到完成所有数据。

为了给你一些背景知识，我有超过 25,000 行数据（菜单项）和最长的列（我相信是 219）。到目前为止，我一直在尝试我在网上找到的脚本片段，但是 none 其中的脚本与我需要的类似，我不知道如何编写足够的代码来自己编写脚本.我相信我需要建立一个变量：列名（不确定我是否可以使用我发现的正则表达式代码提取它）然后在偏移量中使用它...... 但我的范围需要是动态的和循环的…… 如果您能提供帮助，请告诉我 - 我已经坚持了一个星期了！

非常感谢大家的阅读——如果我能提供额外的细节，请告诉我。

Answer 1

例如你可以这样做：

Sub Tester()

    Dim arr, i As Long, c As Range, v, col, price
    
    For Each c In Range("G2:G4").Cells
        v = Replace(Replace(c.Value, "{", ""), "}", "") 'remove braces
        If Len(c.Value) > 0 Then                        'anything to process?
            arr = Split(v, ";")                         'split on ;
            For i = 0 To UBound(arr) - 1 Step 2         'loop 2 at a time
                col = CLng(Trim(arr(i)))                'column number
                price = Trim(arr(i + 1))                'price
                c.Offset(0, col).Value = col & ";" & price
            Next i
        End If
    Next c

End Sub

Excel VBA 根据提取的单元格值循环、复制、粘贴、偏移的宏

Excel VBA Macro to loop, copy, paste, offset based on extracted cell value

excel

vba

parsing

offset