用辅助列处理，3步完成：
1、C1输入
=MAX((LEN(A1)-LEN(SUBSTITUTE(A1,";",))),(LEN(B1)-LEN(SUBSTITUTE(B1,";",))))+1
回车并向下填充；
2、D1输入
=INDEX(A:A,SMALL(IF($C$1:$C$1000>=COLUMN(1:1),ROW($1:$1000),4^8),ROW(1:1)))&""
数组公式，输入后先不要回车，按Ctrl+Shift+Enter结束计算，再向右填充到E1，选D1~E1一起向下填充；
3、F1输入
=TRIM(MID(SUBSTITUTE(D1,";",REPT(" ",99)),IF((LEN(D1)-LEN(SUBSTITUTE(D1,";",))),COUNTIF(D$1:D1,D1),1)*99-98,99))
回车并向右填充到G1，选F1~G1一起向下填充；
【F~G列就是你要实现的数据。可以用“选择性粘贴”为数值保留起来，之前的列就可以删除掉。也可以把C~E列隐藏起来就行，数据可以形成动态】
多谢您这么认真耐心的截图回答！想追问您一下：实际的数据量很大，大概有800行，有的单元格里有10个左右的数据，用您的方法也可以吗？
追答我给你设置到1000行，够用吧？
你也可以根据自己需要设置到10000行或更多。
单元格里有10个左右的数据也没关系。
哥哥 我看您举的例子都是一对多的 我的数据里有多对多的 我举的例子不好 没有说明白 您看多对多也可以吗？
另一个哥哥用VBA比您早的做了出来 不能采纳您的了 十分抱歉。。希望您不要介意，抱歉，非常感谢您
“一对多”是你给的例子，而不是我举的例子。我是按照你给的例子设置公式的哦。
你要“多对多”的：
C列“取大”改为相乘：
=(LEN(A1)-LEN(SUBSTITUTE(A1,";",))+1)*(LEN(B1)-LEN(SUBSTITUTE(B1,";",))+1)
D~E列不变。
F列公式当中的引用IF((LEN(D1)-LEN(SUBSTITUTE(D1,";",))),COUNTIF(D$1:D1,D1),1)
改为(MOD(ROW(),LEN(D1)-LEN(SUBSTITUTE(D1,";",))+1)+1)，还可以比原来的更短些。
G列改为(INT(MOD(INT(ROW()/(LEN(D1)-LEN(SUBSTITUTE(D1,";",))+1)),LEN(E1)-LEN(SUBSTITUTE(E1,";",))+1))+1)
我的回答时间是2015-02-15 11:44，他的回答是2015-02-15 22:03.谁更早？
算了，你已经采纳答案结束提问了。
虽然你已经采纳了其他答案，但我还是回答一下吧。我的方法可能有些麻烦吧。
1、把A、B两列的数据复制到word。
2、选择word中那些数据，使用word的文本转换成表格功能，把它们转换成表格。如下图所示。
3、见下图。
4、查找和替换后，得到这样的表格。
5、把word中的表格复制粘贴回excel，粘贴选项选择“匹配目标格式”。
6、调整下列宽，得到下图这样的。
7、上图中还有一些空格，和你的要求不一样，这个时候可以按下图这样做。
看D1里面的公式=LOOKUP(1,0/($A$1:A1<>""),$A$1:A1)
E1里面的公式=LOOKUP(1,0/($B$1:B1<>""),$B$1:B1)
然后向下填充就可以了。
最后得到的结果就是D、E两列。
终于OK了！！
追问才回来看到 多谢您！但实际的数据量相当大，有800行，每个单元格里可能会有10个左右的数据，实际操作起来如果用您的方法会很费时间，还是多谢您这么热心，又这么耐心的截图，作答，非常感谢！希望能交个朋友~
追答我也是闲的没事干，哈哈
追问哈哈 交个朋友喽~
Sub test()
Dim i&, j&, r&
Dim arr
r = Cells(Rows.Count, 1).End(3).Row
arr = Range("A1:B" & r)
Sheets(2).Select
Range("A:B").ClearContents
k = 1
For i = 1 To UBound(arr)
y1 = Split(arr(i, 1), ";")
y2 = Split(arr(i, 2), ";")
If UBound(y1) > 0 And UBound(y2) = 0 Then
For j = 0 To UBound(y1)
Cells(k, 1) = y1(j)
Cells(k, 2) = arr(i, 2)
k = k + 1
Next
Else
If UBound(y2) > 0 And UBound(y1) = 0 Then
For j = 0 To UBound(y2)
Cells(k, 1) = arr(i, 1)
Cells(k, 2) = y2(j)
k = k + 1
Next
Else
For m = 0 To UBound(y1)
For n = 0 To UBound(y2)
Cells(k, 1) = y1(m)
Cells(k, 2) = y2(n)
k = k + 1
Next
Next
End If
End If
Next
End Sub追问
老哥 麻烦你贴下代码吧
追答Sub test()
Dim i&, j&, r&
Dim arr
r = Cells(Rows.Count, 1).End(3).Row
arr = Range("A1:B" & r)
Sheets(2).Select
Range("A:B").ClearContents
k = 1
For i = 1 To UBound(arr)
y1 = Split(arr(i, 1), ";")
y2 = Split(arr(i, 2), ";")
If UBound(y1) > 0 And UBound(y2) = 0 Then
For j = 0 To UBound(y1)
Cells(k, 1) = y1(j)
Cells(k, 2) = arr(i, 2)
k = k + 1
Next
Else
If UBound(y2) > 0 And UBound(y1) = 0 Then
For j = 0 To UBound(y2)
Cells(k, 1) = arr(i, 1)
Cells(k, 2) = y2(j)
k = k + 1
Next
Else
For m = 0 To UBound(y1)
For n = 0 To UBound(y2)
Cells(k, 1) = y1(m)
Cells(k, 2) = y2(n)
k = k + 1
Next
Next
End If
End If
Next
End Sub
1. 多项目的先复制。如第一行，复制为2行。
2. 然后将B 项分列 成为 2列。
3. 手工删除重复项目
4. 其他的同样道理，手工处理。追问
哥们 数据量很大 我这就是举个例子 还是多谢了
追答多大的数据量？
追问。。。10个800行2列的表格 主要是我想问个方法
