Question

EXCEL VBA给Sheet1单元的内容中间插入Sheet2内容（求助高手：详细见图示）

1。有三个表分别为Sheet1/Sheet2/Sheet3（Sheet1/Sheet2/Sheet3内容范围可自定）
2。将Sheet1和Sheet2生成的结果放到Sheet3
3。安键在Sheet3
http://pan.baidu.com/s/1eQivNkY





Answer 1

VBA实现，代码如下，附件中文件是写好的代码的供参考

Sub 合并()
Sheets(3).Cells.Clear
For Each rng1 In Sheets(1).Cells.SpecialCells(xlCellTypeConstants)
r = 1
c = c + 1
    For Each rng2 In Sheets(2).Cells.SpecialCells(xlCellTypeConstants)
        Sheets(3).Cells(r, c) = Mid(rng1.Value, 1, 1) & rng2.Value & Mid(rng1.Value, 2, 1)
        r = r + 1
    Next rng2
Next rng1
MsgBox ("非空单元格共：" & Sheets(3).Cells.SpecialCells(xlCellTypeConstants).Count & "个")
Sheets(3).Select
End Sub

 

追问

效果非常好,

结果也要像Sheet1一样布置,以你的表为Sheet1例,BCF列没有数据,生成结果也应当没有数据(看下面的图)

http://pan.baidu.com/s/1eQivNkY(这个是原表)

Sheet1(b5:k14数据范围)/Sheet2/(b5:k14数据范围)

Sheet3(A5至J5)单元以下为生成出的数据

效果是对的
以下面表格为准
http://pan.baidu.com/s/1eQivNkY
Sheet1(B5:k14范围)/Sheet2(B5:k14范围)
Sheet3(生成数据在A5-J5以下单元)且数布与Sheet1相同

追答

改下代码就好了，都求VBA总要了解一点呀...

 

修改后代码如下，附件中文件供参考

Sub 合并()
Sheets(3).Cells.ClearContents
For Each rng1 In Sheets(1).Range("B5:K15").SpecialCells(xlCellTypeConstants)
If Sheets(3).Cells(5, rng1.Column - 1) = "" Then
    r = 5
Else
    r = Sheets(3).Cells(5, rng1.Column - 1).End(xlDown).Row + 1
End If
    For Each rng2 In Sheets(2).Range("B5:K15").SpecialCells(xlCellTypeConstants)
        Sheets(3).Cells(r, rng1.Column - 1) = Mid(rng1.Value, 1, 1) & rng2.Value & Mid(rng1.Value, 2, 1)
        r = r + 1
    Next rng2
Next rng1
MsgBox ("非空单元格共：" & Sheets(3).Cells.SpecialCells(xlCellTypeConstants).Count & "个")
Sheets(3).Select
End Sub

追问

Sheet3生成结果也同样是文本行吗

追答

可以将代码改成以下形式即可

Sub 合并()
Sheets(3).Cells.ClearContents
For Each rng1 In Sheets(1).Range("B5:K15").SpecialCells(xlCellTypeConstants)
If Sheets(3).Cells(5, rng1.Column - 1) = "" Then
    r = 5
Else
    r = Sheets(3).Cells(5, rng1.Column - 1).End(xlDown).Row + 1
End If
    For Each rng2 In Sheets(2).Range("B5:K15").SpecialCells(xlCellTypeConstants)
        Sheets(3).Cells(r, rng1.Column - 1) = Mid(rng1.Value, 1, 1) & rng2.Value & Mid(rng1.Value, 2, 1)
        Sheets(3).Cells(r, rng1.Column - 1).NumberFormatLocal = "@"
        r = r + 1
    Next rng2
Next rng1
MsgBox ("非空单元格共：" & Sheets(3).Cells.SpecialCells(xlCellTypeConstants).Count & "个")
Sheets(3).Select
End Sub

Answer 2

插入到中间，这也不是词啊

追问

Sheet1/Sheet2/组合结果到Sheet3
就这样组成
不管它是不是词

Answer 3

VBA编码可以实现。麻烦发送资料，点名字可邮箱。

追问

http://pan.baidu.com/s/1eQivNkY
已经发到你

Answer 4

没听明白怎么放

追问

见补充图片