[發問] 如何將表單1+表單2 合併

owen9399

Dear 各位大大:

如何將表單1+表單2 合併

合併的內容 會依順序排列

合併.rar (1.47 KB)

下載次數: 19

2012-3-16 11:17

register313

回復 1# owen9399

1. Sub xx()
   
2. With Sheets("全部合計")
   
3.   .Columns("A:D") = ""
   
4.   Sheets("小型公司").Range("A1:D" & Sheets("小型公司").[D65536].End(xlUp).Row).Copy .[A1]
   
5.   Sheets("大型公司").Range("A2:D" & Sheets("大型公司").[D65536].End(xlUp).Row).Copy .[A65536].End(xlUp).Offset(1, 0)
   
6.   .[A1].CurrentRegion.Sort Key1:=.[A1], Order1:=xlAscending, Header:=xlGuess
   
7. End With
   
8. End Sub

複製代碼

owen9399

回復 2# register313


    非常感謝大大的指導

   真的很棒

owen9399

回復 3# owen9399

請問大大 這個 我修改卻不能 有誤
我套別的 檔案



    業務員業績表合併0316.rar (118.54 KB)

下載次數: 14

2012-3-16 15:24

register313

回復 4# owen9399

1. Sub 全部公司總年報_按鈕1_Click()
   
2. With Sheets("全部公司總年報")
   
3.   .Columns("A:J") = ""
   
4.   Sheets("小型股年報").Range("A1:J" & Sheets("小型股年報").[J65536].End(xlUp).Row).Copy
   
5.   .[A1].PasteSpecial xlPasteValues
   
6.   Sheets("大型股年報").Range("A2:J" & Sheets("大型股年報").[J65536].End(xlUp).Row).Copy
   
7.   .[A65536].End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
   
8.   .[A1].CurrentRegion.Sort Key1:=.[A1], Order1:=xlAscending, Header:=xlGuess
   
9. End With
   
10. End Sub

複製代碼

owen9399

回復 5# register313


    問題:   小型股的年報+大型股的年報 並沒有合併,且按照順序
          因為 每一頁 共40家公司 ,因此會重復    表頭
      公司序號        公司        總張數        總股數        總應付        總已付(公司進貨)        總退回        多領        尚欠        備註

register313

回復 6# owen9399

1. Sub 全部公司總年報_按鈕1_Click()
   
2. Application.ScreenUpdating = False
   
3. With Sheets("全部公司總年報")
   
4.   .Columns("A:J") = ""
   
5.   Sheets("小型股年報").Range("A1:J" & Sheets("小型股年報").[J65536].End(xlUp).Row).Copy
   
6.   .[A1].PasteSpecial xlPasteValues
   
7.   Sheets("大型股年報").Range("A2:J" & Sheets("大型股年報").[J65536].End(xlUp).Row).Copy
   
8.   .[A65536].End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
   
9.   LR = .UsedRange.Rows.Count
   
10.   For R = LR To 2 Step -1
    
11.     If .Cells(R, 1) = .Cells(1, 1) Or .Cells(R, 1) = O Or Application.CountA(.Rows(R)) = 0 Then
    
12.       .Rows(R).Delete
    
13.     End If
    
14.   Next R
    
15.   .[A1].CurrentRegion.Sort Key1:=.[A1], Order1:=xlAscending, Header:=xlGuess
    
16. End With
    
17. Application.ScreenUpdating = True
    
18. End Sub
    

複製代碼

Hsieh

回復 6# owen9399

1. Sub All_Paper() '全部年報
   
2. Dim Sh As Worksheet, A As Range, C As Range, Ay()
   
3. For Each Sh In Sheets(Array("小型股", "大型股"))
   
4.    With Sh
   
5.      Set A = .[A:A].Find("公司序號", .[A65536], lookat:=xlWhole)
   
6.      Do Until Application.CountA(A.Offset(, 1).Resize(, 12)) = 0
   
7.         r = A.Row
   
8.         r1 = .Range("A:A").Find("合計", A, lookat:=xlWhole).Row
   
9.         r2 = .Range("A:A").FindNext(.Cells(r1, 1)).Row
   
10.         For Each C In A.Offset(, 1).Resize(, 12).SpecialCells(xlCellTypeConstants)
    
11.         k = C.Column
    
12.         ReDim Preserve Ay(s)
    
13.         Ay(s) = Array(.Cells(r, k).Value, .Cells(r + 1, k).Value, .Cells(r1 + 1, k - 1).Value, .Cells(r1, k).Value, .Cells(r1 + 1, k + 1).Value, .Cells(r2, k).Value, .Cells(r2 + 1, k).Value)
    
14.         s = s + 1
    
15.         Next
    
16.      Set A = .Range("A:A").Find("公司序號", .Cells(r2, 1), lookat:=xlWhole)
    
17.      Loop
    
18.    End With
    
19. Next
    
20. If s > 0 Then
    
21. With Sheets("全部公司總年報")
    
22. .[A2].Resize(s, 7) = Application.Transpose(Application.Transpose(Ay))
    
23. .Range("A1").CurrentRegion.Sort key1:=.[A1], Header:=xlYes
    
24. End With
    
25. End If
    
26. End Sub
    
27. Sub S_Paper() '小型股年報
    
28. Dim A As Range, C As Range, Ay()
    
29.    With Sheets("小型股")
    
30.      Set A = .[A:A].Find("公司序號", .[A65536], lookat:=xlWhole)
    
31.      Do Until Application.CountA(A.Offset(, 1).Resize(, 12)) = 0
    
32.         r = A.Row
    
33.         r1 = .Range("A:A").Find("合計", A, lookat:=xlWhole).Row
    
34.         r2 = .Range("A:A").FindNext(.Cells(r1, 1)).Row
    
35.         For Each C In A.Offset(, 1).Resize(, 12).SpecialCells(xlCellTypeConstants)
    
36.         k = C.Column
    
37.         ReDim Preserve Ay(s)
    
38.         Ay(s) = Array(.Cells(r, k).Text, .Cells(r + 1, k).Value, .Cells(r1 + 1, k - 1).Value, .Cells(r1, k).Value, .Cells(r1 + 1, k + 1).Value, .Cells(r2, k).Value, .Cells(r2 + 1, k).Value)
    
39.         s = s + 1
    
40.         Next
    
41.      Set A = .Range("A:A").Find("公司序號", .Cells(r2, 1), lookat:=xlWhole)
    
42.      Loop
    
43.    End With
    
44. If s > 0 Then
    
45. With Sheets("小型股年報")
    
46. .[A2].Resize(s, 7) = Application.Transpose(Application.Transpose(Ay))
    
47. .Range("A1").CurrentRegion.Sort key1:=.[A1], Header:=xlYes
    
48. End With
    
49. End If
    
50. End Sub
    
51. Sub U_Paper() '大型股年報
    
52. Dim A As Range, C As Range, Ay()
    
53.    With Sheets("大型股")
    
54.      Set A = .[A:A].Find("公司序號", .[A65536], lookat:=xlWhole)
    
55.      Do Until Application.CountA(A.Offset(, 1).Resize(, 12)) = 0
    
56.         r = A.Row
    
57.         r1 = .Range("A:A").Find("合計", A, lookat:=xlWhole).Row
    
58.         r2 = .Range("A:A").FindNext(.Cells(r1, 1)).Row
    
59.         For Each C In A.Offset(, 1).Resize(, 12).SpecialCells(xlCellTypeConstants)
    
60.         k = C.Column
    
61.         ReDim Preserve Ay(s)
    
62.         Ay(s) = Array(.Cells(r, k).Text, .Cells(r + 1, k).Value, .Cells(r1 + 1, k - 1).Value, .Cells(r1, k).Value, .Cells(r1 + 1, k + 1).Value, .Cells(r2, k).Value, .Cells(r2 + 1, k).Value)
    
63.         s = s + 1
    
64.         Next
    
65.      Set A = .Range("A:A").Find("公司序號", .Cells(r2, 1), lookat:=xlWhole)
    
66.      Loop
    
67.    End With
    
68. If s > 0 Then
    
69. With Sheets("大型股年報")
    
70. .[A2].Resize(s, 7) = Application.Transpose(Application.Transpose(Ay))
    
71. .Range("A1").CurrentRegion.Sort key1:=.[A1], Header:=xlYes
    
72. End With
    
73. End If
    
74. End Sub

複製代碼

owen9399

回復 8# Hsieh


    謝謝大大

  1.我想請教一下   (我分別 在 小型股年報.大型股年報.全部公司總年報中)
   
   新增    已退回        已補貨
  
  可以修改
  小型股年報+大型股年報合併  ,全部公司總年報把(A~F)的範圍複製並依順利排列

  而  總退回~已補貨 不用處理 (我自己要用計算處理)
   
   而且, 全部公司總年報,每40家公司排成 1大頁
                      第41家公司  為第2頁起

  2.如何 輸入 小型股或大型股資料  自動存入  小型股或大型股的年報中  (因為我是用 儲存格等於方式比較費時)
     也是 每一頁 共 40家公司

  非常感謝
  3.我按好幾下 全部公司總年報  的按鈕時,可以設計 不影響 總退回~已補貨 的公式嗎?
      因為 會自動覆蓋

業務員業績表合併0318.rar (120.1 KB)

下載次數: 9

2012-3-17 12:54

Hsieh

回復 9# owen9399

1. Sub 全部公司總年報_按鈕1_Click()
   
2. Dim Sh As Worksheet, A As Range, C As Range, Ay()
   
3. For Each Sh In Sheets(Array("小型股", "大型股"))
   
4.    With Sh
   
5.      Set A = .[A:A].Find("公司序號", .[A65536], lookat:=xlWhole)
   
6.      Do Until Application.CountA(A.Offset(, 1).Resize(, 12)) = 0
   
7.           r = A.Row   
   
8.         r1 = .Range("A:A").Find("合計", A, lookat:=xlWhole).Row
   
9.         r2 = .Range("A:A").FindNext(.Cells(r1, 1)).Row
   
10.         For Each C In A.Offset(, 1).Resize(, 12).SpecialCells(xlCellTypeConstants)
    
11.         k = C.Column
    
12.         ReDim Preserve Ay(s)
    
13.         Ay(s) = Array(.Cells(r, k).Value, .Cells(r + 1, k).Value, .Cells(r1 + 1, k - 1).Value, .Cells(r1, k).Value, .Cells(r1 + 1, k + 1).Value, .Cells(r2, k).Value, "=rc6-rc5-rc10+rc11", "=if(rc5-rc6-rc10>0,0,rc6-rc5-rc10)", "=if(rc5-rc6-rc11<0,0,rc5-rc6-rc11)")
    
14.         s = s + 1
    
15.         Next
    
16.      Set A = .Range("A:A").Find("公司序號", .Cells(r2, 1), lookat:=xlWhole)
    
17.      Loop
    
18.    End With
    
19. Next
    
20. If s > 0 Then
    
21. With Sheets("全部公司總年報")
    
22. .[A2].Resize(s, 9) = Application.Transpose(Application.Transpose(Ay))
    
23. .Range("A1").CurrentRegion.Sort key1:=.[A1], Header:=xlYes
    
24. r = 42: k = 0
    
25. Do Until .Cells(r, 1) = ""
    
26. .Cells(r, 1).EntireRow.Insert
    
27. .[A1:I1].Copy .Cells(r, 1)
    
28. k = k + 1
    
29. r = r + 40 + k
    
30. Loop
    
31. End With
    
32. End If
    
33. End Sub

複製代碼