Board logo

標題: [發問] 如何將表單1+表單2 合併 [打印本頁]
作者: owen9399    時間: 2012-3-16 11:19     標題: 如何將表單1+表單2 合併

本帖最後由 owen9399 於 2012-3-16 15:56 編輯

Dear 各位大大:

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

合併的內容 會依順序排列

[attach]10013[/attach]
作者: register313    時間: 2012-3-16 13:34

回復 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    時間: 2012-3-16 14:57

回復 2# register313


    非常感謝大大的指導

   真的很棒
作者: owen9399    時間: 2012-3-16 15:26

回復 3# owen9399

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



    [attach]10016[/attach]
作者: register313    時間: 2012-3-16 16:26

回復 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    時間: 2012-3-16 17:02

回復 5# register313


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

回復 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    時間: 2012-3-16 21:37

回復 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    時間: 2012-3-17 13:04

本帖最後由 owen9399 於 2012-3-17 13:26 編輯

回復 8# Hsieh


    謝謝大大

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

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

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

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

[attach]10036[/attach]
作者: Hsieh    時間: 2012-3-17 19:03

回復 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
複製代碼
作者: owen9399    時間: 2012-3-19 09:41

回復 10# Hsieh


    謝謝大大的提供 真厲害
作者: owen9399    時間: 2012-3-19 17:57

回復 10# Hsieh

    DEAR 大大:
    我有發現問題 想請教;
   
   1.當 按總年報 產生 第二頁起      "已退回 已補貨        備註"卻沒有顯示出來
  2.當 每次 一直按  總年報的按鈕  A2 的直會產生變化  而且 G2~I2的顏色也一直複製,可以設計  清除 A2~L65536的值  的按鈕
    (作法 按全部年報的按鈕 很多次數據就改變,而新增 清除鈕  按一次後,再按 全部年報的按鈕 就恢復正常)

   謝謝大大
作者: Hsieh    時間: 2012-3-19 18:55

回復 12# owen9399
  1. Sub 全部公司總年報_按鈕1_Click()


  4. Dim Sh As Worksheet, A As Range, C As Range, Ay()

  6. For Each Sh In Sheets(Array("小型股", "大型股"))

  8.    With Sh

  10.      Set A = .[A:A].Find("公司序號", .[A65536], lookat:=xlWhole)

  12.      Do Until Application.CountA(A.Offset(, 1).Resize(, 12)) = 0

  14.          r = A.Row

  16.         r1 = .Range("A:A").Find("合計", A, lookat:=xlWhole).Row

  18.         r2 = .Range("A:A").FindNext(.Cells(r1, 1)).Row

  20.        For Each C In A.Offset(, 1).Resize(, 12).SpecialCells(xlCellTypeConstants)

  22.         k = C.Column

  24.         ReDim Preserve Ay(s)

  26.        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)")

  28.         s = s + 1

  30.         Next

  32.         Set A = .Range("A:A").Find("公司序號", .Cells(r2, 1), lookat:=xlWhole)
  33.         
  34.      Loop

  36.    End With

  38. Next

  40. If s > 0 Then

  42. With Sheets("全部公司總年報")
  43. .UsedRange.Offset(1).Clear

  45. .[A2].Resize(s, 9) = Application.Transpose(Application.Transpose(Ay))

  47. .Range("A1").CurrentRegion.Sort key1:=.[A1], Header:=xlYes

  49. r = 42: k = 0

  51. Do Until .Cells(r, 1) = ""

  53. .Cells(r, 1).EntireRow.Insert

  55. .[A1:L1].Copy .Cells(r, 1)

  57. k = k + 1

  59. r = r + 40 + k

  61. Loop

  63. End With

  65. End If



  69. End Sub
複製代碼
作者: owen9399    時間: 2012-3-19 22:51

回復 13# Hsieh


    感恩 大大,有你的指導和耐心的處理我們很小部份的問題, 真的很謝謝你:)



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)