Vba excel多列匹配

我在excel中有以下类型的数据：

Col 1       Col 2       Col 3
a           Apple       x & y & z
a           Ant         x & y & z
a           Aeroplane   x & y & z
b           Ball        m & n
b           Bat         m & n
c           Cat         k & l
c           Carrom      k & l
c           Can         k & l

我想按字符分隔/拆分第3列中的值，然后为每个值创建额外的行（&C）。结果应如下所示：

Col 1       Col 2       Col 3
a           Apple       x
a           Apple       y
a           Apple       z
a           Ant         x
a           Ant         y
a           Ant         z
a           Aeroplane   x
a           Aeroplane   y
a           Aeroplane   z
b           Ball        m
b           Ball        n

我使用的值只是示例，实际数据包含第3列中用&分隔的单词

---

由于这是“一次性”的，我会手动修复

将第3列中只有一项的所有行放入新工作表。 把有两个项目的放在另一张纸上 等等 然后，去掉两个项目表上的第一个项目，并将其复制到第一个项目表中 然后剥去两个项目表上的第二个项目，并将其复制到第一个项目表中。 继续，最终你会得到你想要的数据

---

虽然这需要很长时间，但可能比学习VBA并编写一个例程要快。

此代码将根据给定的信息执行您想要执行的操作。我鼓励您查找所使用的方法，因为它们是非常基本的，并且是困难的新手。我已经写下了解释每个部分正在做什么的评论。德国劳埃德船级社

Sub test()
Dim filter, C1, C2 As String
Dim counter As Integer
Dim letters() As String
Dim i, x As Integer
Dim char As String

Cells(1, 3).Select
x = 1

'Checks to see if the third column is blank, if not it will continue
While Cells(x, 3).Value <> ""

'Re instantiates an array of size 3 to store the letters (technically 4 since 0 is also a position) Also erases past stored data
ReDim letters(3) As String
i = 0
'Filter stores the whole string
filter = ActiveCell.Value

'Stores the column A and B values  of that row in C1 and C2
C1 = ActiveCell.Offset(, -2).Value
C2 = ActiveCell.Offset(, -1).Value

'This for loop goes through each character of filter string
For counter = 1 To Len(filter)
'char stores the character
char = Mid(filter, counter, 1)
    If char = " " Or char = "&" Then
    Else:
    'stores any character not blank and "&" in an array
    letters(i) = char
    i = i + 1
    End If
Next

'If statement to skip rows that only have 1 letter
If letters(1) <> Empty Then

'For loop that will create a new line and print out array letters in each new row
For i = 0 To 1
ActiveCell.Value = letters(i)
  ActiveCell.Offset(1).EntireRow.Insert
  ActiveCell.Offset(1).Select
  ActiveCell.Offset(, -2).Value = C1
  ActiveCell.Offset(, -1) = C2
  ActiveCell.Value = letters(i + 1)
Next i
End If
x = x + 1
ActiveCell.Offset(1).Select

Wend
End Sub

子测试（）
变光滤波器，C1，C2作为字符串
作为整数的Dim计数器
将字母（）设置为字符串
Dim i，x为整数
Dim char作为字符串
单元格（1，3）。选择
x=1
'检查第三列是否为空，否则将继续
而单元格（x，3）。值“”
'重新实例化一个大小为3的数组来存储字母（从技术上讲是4，因为0也是一个位置），也会擦除过去存储的数据
将字母（3）重拨为字符串
i=0
'过滤器存储整个字符串
filter=ActiveCell.Value
'将该行的A列和B列值存储在C1和C2中
C1=ActiveCell.Offset（，-2）.值
C2=ActiveCell.Offset（，-1）.值
'此for循环遍历筛选器字符串的每个字符
对于计数器=1到Len（过滤器）
'char存储字符
char=Mid（过滤器、计数器、1）
如果char=“”或char=“&”，则
其他：
'在数组中存储任何非空字符和“&”
字母（i）=字符
i=i+1
如果结束
下一个
'If语句跳过只有1个字母的行
如果字母（1）为空，则
'For循环，该循环将创建新行并在每一新行中打印出数组字母
对于i=0到1
ActiveCell.Value=字母（i）
ActiveCell.Offset（1）.EntireRow.Insert
ActiveCell.Offset（1）。选择
ActiveCell.Offset（，-2）.Value=C1
活动单元格偏移量（，-1）=C2
ActiveCell.Value=字母（i+1）
接下来我
如果结束
x=x+1
ActiveCell.Offset（1）。选择
温德
端接头

欢迎使用堆栈溢出！您的问题只包含需求-它并没有显示您自己为解决此问题所做的任何努力。请添加您对此问题的尝试-因为此网站不是免费的“我们为您（家庭）工作”服务。除此之外：请转到第页了解如何/问什么。谢谢对不起，我没有付出任何努力。我所尝试的只是各种各样的excel公式，它们喜欢打破这个值，但都不起作用。我是vba新手，所以在这里发帖。对不起，这不是“我们为你工作”服务。如果你想从你的VBA活动中得到一些真正的结果，那就没有弯路了。你最好拿起一本好书/教程开始学习。或者你决定雇用一个人并支付工作费用。任何人免费做这件事的机会都很小，不指望你去工作或解决它。任何关于如何实现的指针都应该足够了。好吧，那么看看这样做的数据是非常大的。谢谢你的建议，谢谢TJYen。这适用于字母，我将根据需要对其进行更改，因为最后一列中也可以有单词。对于字符，您可以使用循环来计算到下一个空格前的字符数。然后只需在“char=Mid（filter，counter，'接收的字符数）”中使用它来获取单词