返回列表 上一主題 發帖

[發問] 請教如何使用vba遍歷各工作表之相同範圍內容COPY至主頁並適時新增Columns數

cmo140497

帖子
95 
主題
29 
精華
0 
積分
150 
點名
0  
作業系統
windows2003 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
來自
Kaoshiung 
註冊時間
2010-11-5 
最後登錄
2018-2-8 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-1-23 17:28 | 只看該作者

[發問] 請教如何使用vba遍歷各工作表之相同範圍內容COPY至主頁並適時新增Columns數

Dear 版主或各位大大們 :
小弟因為sheet上方會有些圖表,設定為不隨儲存格大小作變動,但又需取得其它sheet之資料(其來源行列數會變動),是否可以每個Sheet之相同位址b2:p12,分別複製資料至Sheet1 b5位址開始,如遇欄位數不足,自動新增來源之columns數,每排僅能有三個範圍資料,第四個則跳第二排,直至結束




Get each sheet data to mainsheet_2013-01-23.zip (27 KB)
收藏 分享

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 2013-1-24 19:15 | 只看該作者
本帖最後由 stillfish00 於 2013-1-24 19:16 編輯

回復 1# cmo140497
1.
>>如遇欄位數不足,自動新增來源之columns數,
敘述看不懂

2.
>>每排僅能有三個範圍資料,第四個則跳第二排
檔案跟圖上顯示的是
僅有二個範圍資料,第三個則跳第二排
   
3.
不過我大該可以猜出你要甚麼...
試看看..
  1. Sub Test()
  2. Dim vCols As Long, cIndex As Long, rIndex As Long
  3. Dim first As Long, last As Long
  4. Dim sCopy As String
  5. Dim r, c

  7. first = 2   'from T02 , 可自行調整
  8. last = 5    'to   T05 , 可自行調整
  9. sCopy = "B2:P12"       '可自行調整

  11. r = Range(sCopy).Rows.Count + 1     '每區塊列數,+1列標題(Wafer TXX)
  12. c = Range(sCopy).Columns.Count + 1  '每區塊欄數,+1欄空白

  14. '可見的欄數總數
  15. vCols = Sheets("sheet1").Cells.SpecialCells(xlCellTypeVisible).Columns.Count

  17. For i = first To last
  18.     rIndex = Int((i - first) / Int(vCols / c))
  19.     cindex = (i - first) Mod Int(vCols / c)
  20.    
  21.     With Sheets("sheet1").[B5].Offset(r * rIndex, c * cindex)
  22.         .Offset(-1, 1).Value = "WAFER"
  23.         .Offset(-1, 2).Value = "T" & Format(i, "00")
  24.         Sheets("T" & Format(i, "00")).Range(sCopy).Copy .Cells(1, 1)    '範圍複製[B2:P12],含格式
  25.     End With
  26. Next i
  27. End Sub
複製代碼

TOP

cmo140497

帖子
95 
主題
29 
精華
0 
積分
150 
點名
0  
作業系統
windows2003 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
來自
Kaoshiung 
註冊時間
2010-11-5 
最後登錄
2018-2-8 
3#
發表於 2013-1-24 19:52 | 只看該作者
回復 2# stillfish00


    您實在太神了,小弟腦筋太死了,其實以版面為主才對,不應該用以新增COLUMNS數,實在太感謝您了,感恩!

TOP

cmo140497

帖子
95 
主題
29 
精華
0 
積分
150 
點名
0  
作業系統
windows2003 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
來自
Kaoshiung 
註冊時間
2010-11-5 
最後登錄
2018-2-8 
4#
發表於 2013-1-24 20:13 | 只看該作者
回復 2# stillfish00


    不好意思,小弟還有一個問題忘了提問,那就是假如Sheets name也不都是T開頭,Sheets數也不太一定只有4個,小弟知道要如何count sheets,但也如何避免其它二頁也被copy進來,請問要如何修正為動態,實在再麻煩您予以指導,感恩!

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
5#
發表於 2013-1-24 21:12 | 只看該作者
回復 4# cmo140497
能舉個例嗎?
>>避免其它二頁也被copy進來
哪兩頁? 有sheet name和 sheet位置順序嗎?
這兩頁外的都要copy嗎?

TOP

cmo140497

帖子
95 
主題
29 
精華
0 
積分
150 
點名
0  
作業系統
windows2003 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
來自
Kaoshiung 
註冊時間
2010-11-5 
最後登錄
2018-2-8 
6#
發表於 2013-1-24 22:47 | 只看該作者
回復 5# stillfish00

不好意思,就main & cals 這兩個sheet資料怕會被copy進來,另如果其它sheet name不是01.02.03的序列,不知要如何代入,再煩請您指導,感恩!


    Get each sheet data to mainsheet_已回覆.zip (36.29 KB)

TOP

cmo140497

帖子
95 
主題
29 
精華
0 
積分
150 
點名
0  
作業系統
windows2003 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
來自
Kaoshiung 
註冊時間
2010-11-5 
最後登錄
2018-2-8 
7#
發表於 2013-1-24 23:49 | 只看該作者
[/code][b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=50094&ptid=8871]6#[/url] [i]cmo140497[/i] [/b]

不好意思,小弟試出來了,用worksheets(index)就OK了,不過仍感謝您的指點迷津,感恩!

[code]Sub Test()
Dim vCols As Long, cIndex As Long, rIndex As Long
Dim first As Long, last As Long
Dim sCopy As String
Dim r, c
Dim myshtc As Long

Worksheets(1).Rows("48:99").Clear

myshtc = ThisWorkbook.Sheets.Count

first = 3   
last = myshtc   
sCopy = "B6:P16"      

r = Range(sCopy).Rows.Count + 1     
c = Range(sCopy).Columns.Count + 1  

'可見的欄數總數
vCols = Sheets("DashBoard").Cells.SpecialCells(xlCellTypeVisible).Columns.Count

For i = first To last
    rIndex = Int((i - first) / Int(vCols / c))
    cIndex = (i - first) Mod Int(vCols / c)
    newR = r * rIndex
    newC = c * cIndex
   
    With Sheets("DashBoard").[R50].Offset(newR, newC)
        .Offset(-1, 1).Value= "ID"        
        .Offset(-1, 2).Value = Worksheets(i).Name        
        Worksheets(i).Range(sCopy).Copy .Cells(1, 1)   
    End With
Next i
End Sub

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
8#
發表於 2013-1-25 01:37 | 只看該作者
回復 7# cmo140497
資料沒缺嗎?
With Sheets("DashBoard").[R50].Offset(newR, newC)   
R50為起始點 ,  vCols應定為
vCols = Sheets("DashBoard").Cells.SpecialCells(xlCellTypeVisible).Columns.Count-49
除非你A:Q都隱藏

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
255  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-25 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
9#
發表於 2013-1-25 09:20 | 只看該作者
回復 7# cmo140497
  1. Sub ex()
  2. With Sheets("summary")
  3. s = .Cells.SpecialCells(xlCellTypeVisible).Columns.Count - 2
  4. .Cells = ""
  5. a = 2: b = 4 '寫入的第一個位置
  6.    For Each sh In Sheets
  7.        If sh.Name <> .Name And sh.Name <> "cals" Then '排除不寫入的工作表
  8.        ar = sh.Range("A1").CurrentRegion.Offset(, 1).Value '所有資料範圍
  9.            ar(1, 2) = ar(1, 1): ar(1, 1) = sh.[A1].Value '更改陣列內容
  10.            r = Int(n / Int(s / (UBound(ar, 2) - 1))) * (UBound(ar, 1) - 1) + b
  11.            k = (n Mod Int(s / (UBound(ar, 2) - 1))) * (UBound(ar, 2) - 1) + a
  12.            n = n + 1 '計算工作表數量
  13.            .Cells(r, k).Resize((UBound(ar, 1) - 1), (UBound(ar, 2) - 1)) = ar
  14.        End If
  15.    Next
  16. End With
  17. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 閒人無樂趣，忙人無是非。
返回列表 上一主題