请大手们帮助

excel白兔

好的老师 这样的 我整理下思绪
1首先运行代码 结果显示到 Sheet1 （这个是要放结果的地方）
2 我这个工作薄里有 表1,2,3,4（这4个是明细表也就是基础表，也就是在这4个表中抓取数据 运行代码结果在sheet1中出现，都抓取什么呢？答 ：品名          产品编码          产品规格         包装规格        产品形态  和不同通入的价格
3 基础表1抓取的价格在基础表1的K列 通入只有17（注意基础表1只有1个通入17）
   基础表2抓取的价格在基础表2的j列  通入多了有11,12,13,15,18（注意基础表2有多个通入但是价格都是一样的在J列）
   基础表3抓取的价格在基础表3的j列 通入多了有11,12,13,15,18，17（注意基础表3有多个通入但是价格都一样的是在J列）
   基础表4抓取的价格在基础表4的o列 通入多了有12,13,                   11,15（注意基础表4有多个通入12,13通入价格都一样的是在o列）（注意基础表4有多个通入11,15通入价格是在在o列对应价格的基础上-0.2）
4基础表中列是固定的了，行不固定（这个可以根据物料编码来检索编码都是提取都是A000000000000到z999999999999）判断
还有就是4个基础表中可能出现有物料 所有的通路下都没有价格这个最好不要显示了也就是不要抓取到汇总表sheet1中了）
请老师帮助呀
                     

易安1

1. Sub test()
   
2. Dim rng As Range, rngs As Range
   
3. Application.ScreenUpdating = False
   
4. Sheets("Sheet1").Range("a3:l65536").ClearContents
   
5. With Sheet4
   
6.     a = .Cells(Rows.Count, 4).End(3).Row
   
7.     .Range(.Cells(4, 4), .Cells(a, 8)).Copy Sheets("Sheet1").[a3]
   
8.     .Range("K4:k" & a).Copy Sheets("Sheet1").[k3]
   
9. End With
   
10. With Sheet3
    
11.     i = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, 1).End(3).Row + 1
    
12.     b = .Cells(Rows.Count, 4).End(3).Row
    
13.     .Range(.Cells(4, 4), .Cells(b, 8)).Copy Sheets("Sheet1").Cells(i, 1)
    
14.     .Range("J4:j" & b).Copy Sheets("Sheet1").Cells(i, "F")
    
15.     .Range("J4:j" & b).Copy Sheets("Sheet1").Cells(i, "g")
    
16.     .Range("J4:j" & b).Copy Sheets("Sheet1").Cells(i, "h")
    
17.     .Range("J4:j" & b).Copy Sheets("Sheet1").Cells(i, "j")
    
18.     .Range("J4:j" & b).Copy Sheets("Sheet1").Cells(i, "k")
    
19. End With
    
20. With Sheet5
    
21.     i = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, 1).End(3).Row + 1
    
22.     c = .Cells(Rows.Count, 4).End(3).Row
    
23.     .Range(.Cells(4, 4), .Cells(c, 8)).Copy Sheets("Sheet1").Cells(i, 1)
    
24.     .Range("J4:j" & c).Copy Sheets("Sheet1").Cells(i, "F")
    
25.     .Range("J4:j" & c).Copy Sheets("Sheet1").Cells(i, "g")
    
26.     .Range("J4:j" & c).Copy Sheets("Sheet1").Cells(i, "h")
    
27.     .Range("J4:j" & c).Copy Sheets("Sheet1").Cells(i, "j")
    
28.     .Range("J4:j" & c).Copy Sheets("Sheet1").Cells(i, "k")
    
29.     .Range("J4:j" & c).Copy Sheets("Sheet1").Cells(i, "l")
    
30. End With
    
31. With Sheet8
    
32.     i = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, 1).End(3).Row + 1
    
33.     d = .Cells(Rows.Count, 4).End(3).Row - 3
    
34.     .Range(.Cells(5, 3), .Cells(d, 7)).Copy Sheets("Sheet1").Cells(i, 1)
    
35.     .Range("o5:o" & d).Copy Sheets("Sheet1").Cells(i, "g")
    
36.     .Range("o5:o" & d).Copy Sheets("Sheet1").Cells(i, "h")
    
37.     .Range("v5:v" & d).FormulaR1C1 = "=RC[-7]-0.2"
    
38.     .Range("v5:v" & d).Copy
    
39.      Sheets("Sheet1").Cells(i, "f").PasteSpecial Paste:=xlPasteValues
    
40.      Sheets("Sheet1").Cells(i, "j").PasteSpecial Paste:=xlPasteValues
    
41. End With
    
42. With Sheets("Sheet1").UsedRange
    
43.     .Interior.Pattern = xlNone
    
44. End With
    
45. i = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, 1).End(3).Row
    
46. Range("x3:x" & i) = "=COUNTIF(RC[-18]:RC[-12],"""")"
    
47. For m = i To 3 Step -1
    
48.     If Cells(m, "X").Value = 7 Then
    
49.     Cells(m, "X").EntireRow.Delete
    
50.     End If
    
51. Next
    
52. For Each rng In Range("a3:a" & i)
    
53.     If rng.Value = "品名" Then rng.EntireRow.Delete
    
54. Next
    
55. [x1:x65536].ClearContents
    
56. Range("A3:A65535").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
57. Columns("A:M").RowHeight = 12.5
    
58. Sheets("Sheet1").Range("a3:l" & i).Borders.LineStyle = xlContinuous
    
59. Application.ScreenUpdating = True
    
60. 
    
61. End Sub
    

复制代码

空行删除已解决 物料单号为空 不知道是什么原因  数据是直接复制的 没有改动 可能是原来数据问题

excel白兔

老师们这4张表可能不是很规则，  可以一个一个弄代码汇总执行到一个表里
因为这样的表有好多个 这4个基础表是覆盖了大部分的情况和格式，我是这样想的要是在添加类似这样的表把对应格式的代码加进去就OK了

易安1

1. Sub test()
   
2. Dim rng As Range, rngs As Range
   
3. Application.ScreenUpdating = False
   
4. Sheets("Sheet1").Range("a3:l65536").ClearContents
   
5. With Sheet4
   
6.     a = .Cells(Rows.Count, 4).End(3).Row
   
7.     .Range(.Cells(4, 4), .Cells(a, 8)).Copy Sheets("Sheet1").[a3]
   
8.     .Range("K4:k" & a).Copy Sheets("Sheet1").[k3]
   
9. End With
   
10. With Sheet3
    
11.     i = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, 1).End(3).Row + 1
    
12.     b = .Cells(Rows.Count, 4).End(3).Row
    
13.     .Range(.Cells(4, 4), .Cells(b, 8)).Copy Sheets("Sheet1").Cells(i, 1)
    
14.     .Range("J4:j" & b).Copy Sheets("Sheet1").Cells(i, "F")
    
15.     .Range("J4:j" & b).Copy Sheets("Sheet1").Cells(i, "g")
    
16.     .Range("J4:j" & b).Copy Sheets("Sheet1").Cells(i, "h")
    
17.     .Range("J4:j" & b).Copy Sheets("Sheet1").Cells(i, "j")
    
18.     .Range("J4:j" & b).Copy Sheets("Sheet1").Cells(i, "k")
    
19. End With
    
20. With Sheet5
    
21.     i = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, 1).End(3).Row + 1
    
22.     c = .Cells(Rows.Count, 4).End(3).Row
    
23.     .Range(.Cells(4, 4), .Cells(c, 8)).Copy Sheets("Sheet1").Cells(i, 1)
    
24.     .Range("J4:j" & c).Copy Sheets("Sheet1").Cells(i, "F")
    
25.     .Range("J4:j" & c).Copy Sheets("Sheet1").Cells(i, "g")
    
26.     .Range("J4:j" & c).Copy Sheets("Sheet1").Cells(i, "h")
    
27.     .Range("J4:j" & c).Copy Sheets("Sheet1").Cells(i, "j")
    
28.     .Range("J4:j" & c).Copy Sheets("Sheet1").Cells(i, "k")
    
29.     .Range("J4:j" & c).Copy Sheets("Sheet1").Cells(i, "l")
    
30. End With
    
31. With Sheet8
    
32.     i = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, 1).End(3).Row + 1
    
33.     d = .Cells(Rows.Count, 4).End(3).Row - 3
    
34.     .Range(.Cells(5, 3), .Cells(d, 7)).Copy Sheets("Sheet1").Cells(i, 1)
    
35.     .Range("o5:o" & d).Copy Sheets("Sheet1").Cells(i, "g")
    
36.     .Range("o5:o" & d).Copy Sheets("Sheet1").Cells(i, "h")
    
37.     .Range("v5:v" & d).FormulaR1C1 = "=RC[-7]-0.2"
    
38.     .Range("v5:v" & d).Copy
    
39.      Sheets("Sheet1").Cells(i, "f").PasteSpecial Paste:=xlPasteValues
    
40.      Sheets("Sheet1").Cells(i, "j").PasteSpecial Paste:=xlPasteValues
    
41. End With
    
42. With Sheets("Sheet1").UsedRange
    
43.     .Interior.Pattern = xlNone
    
44. End With
    
45. i = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, 1).End(3).Row
    
46. Range("x3:x" & i) = "=COUNTIF(RC[-18]:RC[-12],"""")"
    
47. For Each rng In Range("x3:x" & i)
    
48.     If rng.Value = 7 Then
    
49.     rng.EntireRow.Delete
    
50.     End If
    
51. Next
    
52. [x1:x65536].ClearContents
    
53. For Each rng In Range("a3:a" & i)
    
54.     If rng.Value = "品名" Then rng.EntireRow.Delete
    
55. Next
    
56. Range("A3:A65535").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
57. Columns("A:M").RowHeight = 12.5
    
58. Sheets("Sheet1").Range("a3:l" & i).Borders.LineStyle = xlContinuous
    
59. Application.ScreenUpdating = True
    
60. End Sub
    

复制代码

这种代码没什么意义呃 不过要求了 我就尽力写了{:091:} 手已断

易安1

附件参考 提示好像有部分03版本不兼容的格式 自己试试吧 我尽力了{:281:}

excel白兔

易安1 发表于 2014-7-17 13:51
这种代码没什么意义呃 不过要求了 我就尽力写了 手已断

谢谢老师大力的帮助我先仔细看看 研究研究

excel白兔

易安1 发表于 2014-7-17 13:52
附件参考 提示好像有部分03版本不兼容的格式 自己试试吧 我尽力了

谢谢老师的帮助呀万分感谢！！！！老师对就是这样的 呵呵
现在还有1点小问题 就是老师 运行你那代码 在sheet1表格中的第17 和18行 所有通路都无价格 竟然显示出来了 还有就是160行物料号是空的 不知道为什么 老师在帮我看看呗

excel白兔

易安1 发表于 2014-7-17 10:22
空行删除已解决 物料单号为空 不知道是什么原因  数据是直接复制的 没有改动 可能是原来数据问题

谢谢老师的帮助