Board logo

標題: 有錄製巨集但要寫成迴圈還是摸不到邊 [打印本頁]
作者: opman    時間: 2015-1-27 11:53     標題: 有錄製巨集但要寫成迴圈還是摸不到邊

本帖最後由 GBKEE 於 2015-2-2 15:28 編輯

社團數高達120個
學生人數固定40
希望可以將學生名單和成績整理到總表。
希望有大大可以幫忙。相關資料如附件。
作者: luhpro    時間: 2015-1-30 22:40

社團數高達120個
學生人數固定40
希望可以將學生名單和成績整理到總表。
希望有大大可以幫忙。相關資料如 ...
opman 發表於 2015-1-27 11:53
  1. Sub 整理()
  2.   Dim iCol%, iCols%
  3.   Dim lRows1&, lRows2&, lRowsT&, lRow&
  4.   Dim shS1 As Worksheet, shS2 As Worksheet, shST As Worksheet
  5.   
  6.   Set shS1 = Sheets("學生名單")
  7.   Set shS2 = Sheets("成績")
  8.   Set shS3 = Sheets("總表")
  9.   shS3.Cells.Clear
  10.   With shS1
  11.     .[A1].Resize(.Cells(Rows.Count, 1).End(xlUp).Row).Copy shS3.[A1]
  12.     iCols = shS1.Cells(1, Columns.Count).End(xlToLeft).Column
  13.     For iCol = 2 To iCols
  14.       .Cells(1, iCol).Resize(41).Copy shS3.Cells(1, (iCol - 1) * 2)
  15.       shS2.Cells(1, iCol).Resize(41).Copy shS3.Cells(1, (iCol - 1) * 2 + 1)
  16.     Next
  17.   End With
  18. End Sub
複製代碼
[attach]20167[/attach]
作者: opman    時間: 2015-2-1 20:02

回復 2# luhpro


    感謝大大，但我是想接續貼下去。要如何改
作者: GBKEE    時間: 2015-2-2 16:11

回復 3# opman
  1. Option Explicit
  2. Sub 整理()
  3.     Dim iCols%, i%, iRows&
  4.     Dim Rng As Range
  5.     Sheets("總表").UsedRange.Clear
  6.     iRows = Sheets("學生名單").UsedRange.Rows.Count '標頭 + 學生人數
  7.     iCols = Sheets("成績").UsedRange.Columns.Count  '社團數
  8.     For i = 2 To iCols
  9.         Set Rng = Sheets("總表").Cells(Sheets("總表").Rows.Count, "a").End(xlUp)
  10.         '往下貼的位置
  11.         With Rng.Offset(IIf(Rng.Row = 1, 0, 1)).Resize(iRows)
  12.             .Cells = Sheets("學生名單").Columns(1).Value       '第一欄:學生名單
  13.             .Offset(, 1) = Sheets("學生名單").Columns(i).Value '第二欄:學生名稱
  14.             .Offset(, 2) = Sheets("成績").Columns(i).Value     '第三欄:學生成績
  15.         End With
  16.     Next
  17. End Sub
複製代碼
作者: opman    時間: 2015-2-2 20:50

回復 4# GBKEE


     完全符合 謝謝大大 拜讀中



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