Office中国论坛/Access中国论坛

标题: [求助] 按顺序复制3个sheet里的内容到sheet4，且每个部分之间空一行 [打印本页]

---

作者: 酹寒    时间: 2017-12-8 14:39
标题: [求助] 按顺序复制3个sheet里的内容到sheet4，且每个部分之间空一行
把sheet1、sheet2、sheet3三个部分中的内容按表格中的编号“profliecode”顺序依次复制到sheet4里面，要求每两个部分之间空一行。
   
其中sheet1、sheet3里的“profliecode”每个编号都是唯一的，而sheet2里每个编号会对应多行内容。应该是需要用到VBA的，但是我不会。。。哭。。。

希望大神能帮我把这些内容都整合成sheet4里的形式，感激不尽！

---

作者: 酹寒    时间: 2017-12-8 15:36
急求大神的帮助呀。。。

---

作者: access新新新手    时间: 2017-12-9 09:24

酹寒 发表于 2017-12-8 15:36
急求大神的帮助呀。。。

手工复制一下不就完事了

---

作者: pureshadow    时间: 2017-12-11 19:37

1. Sub Sample()
   
2. Dim MyRow As Long, i As Long, j As Long
   
3. Dim MyFind As Range
   
4. i = i + 1
   
5. j = 2
   
6. With Sheets("Sheet2")
   
7.     For MyRow = 2 To 2421
   
8.         Range("a" & i).Resize(1, 11) = Sheets("Sheet1").Range("a1:k1").Value
   
9.         Range("a" & i + 1).Resize(1, 11) = Sheets("Sheet1").Range("a" & MyRow).Resize(1, 11).Value
   
10.         Range("a" & i + 3).Resize(1, 11) = .Range("a1:k1").Value
    
11.         Set MyFind = .Range("c:c").Find(Sheets("Sheet1").Range("c" & MyRow + 1))
    
12.             If Not MyFind Is Nothing Then
    
13.                 Range("a" & i + 4).Resize(MyFind.Row - j, 11) = .Range("a" & j).Resize(MyFind.Row - j, 11).Value
    
14.             Else
    
15.                 Range("a" & i + 4).Resize(51219 - j, 11) = .Range("a" & j + 1).Resize(51219 - j, 11).Value
    
16.             End If
    
17.         Range("a" & i + MyFind.Row - j + 5).Resize(1, 11) = Sheets("Sheet3").Range("a1:k1").Value
    
18.         Range("a" & i + MyFind.Row - j + 6).Resize(1, 11) = Sheets("Sheet3").Range("a" & MyRow).Resize(1, 11).Value
    
19.         j = MyFind.Row
    
20.         i = j + 8 * (MyRow - 1)
    
21.     Next
    
22. End With
    
23. Set MyFind = Nothing
    
24. End Sub

复制代码

---

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)

Powered by Discuz! X3.3