这个用excle vba怎么实现

代码如下：

Sub imS()

Range("C:G") = ""

Clm = 4

Ro = 2

Cells(1, Clm) = Cells(1, 1)

For a = 1 To Range("B1").End(xlDown).Row

If Cells(a, 1) = Cells(a + 1, 1) Then

Cells(Ro, Clm) = Cells(a, 2)

Ro = Ro + 1

Else

Cells(Ro, Clm) = Cells(a, 2)

Clm = Clm + 1

Cells(1, Clm) = Cells(Ro, 1)

Ro = 2

GoTo oT1

'FIND ME Q2124102

End If

oT1:

Next

Cells(1, Clm) = ""

End Sub

按Alt+F11，打开VBA编辑器，插入一个模块，把下面的代码贴进去，按F5执行

Sub 宏1()
m = Cells(1, Columns.Count).End(xlToLeft).Column
k = 1
For i = 4 To m
    n = Cells(Rows.Count, i).End(3).Row
    For j = 2 To n
        Cells(k, 1) = Cells(1, i)
        Cells(k, 2) = Cells(j, i)
        k = k + 1
    Next
Next
End Sub

VBA字典+数组代码

用数组和循环嵌套很容易实现

Sub 省市组合()
Dim Ar, Ar2, R&, C&, N&
Range("A:C").ClearContents
Ar = Range("D1").CurrentRegion
ReDim Ar1(1 To UBound(Ar) * UBound(Ar, 2), 1 To 2)
For C = 1 To UBound(Ar, 2)
   If Ar(1, C) = "" Then Exit For
   For R = 2 To UBound(Ar)
      If Ar(R, C) = "" Then Exit For
      N = N + 1
      Ar1(N, 1) = Ar(1, C)
      Ar1(N, 2) = Ar(R, C)
Next R, C
Range("A1").Resize(N, 2) = Ar1
End Sub