Excel如何替换并重新生成新数据

Question

原表有2列
【张三 男】
【王五 女】 以此类推，有几千个。
要把每个男的替换成2行
【张三 A区】
【张三 A舍】
要把每个女的替换成3行
【王五 B区】
【王五 B舍】
【王五 B辅】
--------------------------------------------------
如何通过Excel编程解答出来？
多谢！

Answer 1

　　按 Alt+F11 打开VBE窗口，把下面代码复制到里面，按F5运行即可看到效果，然后酌情修改。

Sub 替换()
Dim i%, j%, x%, xrow%
x = 1
xrow = [a1].CurrentRegion.Rows.Count
For i = 1 To xrow
Select Case Cells(i, 2)
    Case Is = "男"
        For j = 0 To 1
            Cells(x + j, 4) = Cells(i, 1)
        Next j
            Cells(x, 5) = "A区"
            Cells(x + 1, 5) = "A舍"
        x = x + 2
    Case Is = "女"
        For j = 0 To 2
            Cells(x + j, 4) = Cells(i, 1)
        Next j
            Cells(x, 5) = "B区"
            Cells(x + 1, 5) = "B舍"
            Cells(x + 2, 5) = "B辅"
        x = x + 3
    End Select
Next i
End Sub

    

Answer 2

还是直接操作吧。
首先，性别排序。
选中男的，复制成两份。分别选中后替换。
选中女的，复制成三份。分别选中后替换。追问

有几千条记录。而且以后每周还有新数据过来，人工的话，感觉太麻烦，而且容易出错。

追答

噢，想省力啊，那得付费耶。

Answer 3

简化一下问题
先把男的拆分成2行，女的拆分成3行
有个笨办法，没必要用函数和VBA了
笨办法是： 按照男女排序，然后复制所有男名字到行尾，复制所有女名字2次到行尾，
然后再按照名字排序就可以

如果必须要VBA
输入以下代码

Sub abab()
m = 1
For n = 1 To 2000
Range("C" & m).Value = Range("A" & n).Value
Range("D" & m).Value = "A区"
Range("C" & m + 1).Value = Range("A" & n).Value
Range("D" & m + 1).Value = "A舍"
m = m + 2
If Range("B" & n).Value = "女" Then
Range("C" & m).Value = Range("A" & n).Value
Range("D" & m - 2).Value = "B区"
Range("D" & m - 1).Value = "B舍"
Range("D" & m).Value = "B辅"
m = m + 1
End If
Next n
End Sub

Answer 4

这个是两列，那么可以重新生产在c，d列吗 ，如果要达到这个效果，一下代码就可以实现。

Sub 重新生成()

Dim xb%, a%, n%, k%

xb = Cells(Rows.Count, 2).End(xlUp).Row

For a = 1 To xb

    n = n + 1

        If Cells(n, 2) = "男" Then

            Cells(k + 1, "c").Resize(2) = Application.Transpose(Cells(a, 1))

            Cells(k + 1, "d").Resize(2) = Application.Transpose(Array("A区", "A舍"))

            k = k + 2

        Else

            Cells(k + 1, "c").Resize(3) = Application.Transpose(Cells(a, 1))

            Cells(k + 1, "d").Resize(3) = Application.Transpose(Array("B区", "B舍", "B铺"))

            k = k + 3

        End If

Next

End Sub

鼠标点击图片看一下代码执行效果。

本回答被提问者采纳