luke

帖子: 140
主題: 37
精華: 0
積分: 193
點名: 0
作業系統: Windows XP
軟體版本: Office 2007
閱讀權限: 20
註冊時間: 2012-3-28
最後登錄: 2015-7-5

2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2012-4-3 22:30 | 只看該作者

[發問] 如何自訂拷貝次數

各位大大

小弟把常用資料作成資料列選單放在sheet2表資料區,
我想在sheet1表B1至B5去設定拷貝次數,然後複製貼上

煩請先進指導

TEST5.rar (36.82 KB)

樓主熱帖

luke

中學生 Rank: 2

帖子: 140
主題: 37
精華: 0
積分: 193
點名: 0
作業系統: Windows XP
軟體版本: Office 2007
閱讀權限: 20
註冊時間: 2012-3-28
最後登錄: 2015-7-5

2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章

11^#

發表於 2012-4-4 20:58 | 只看該作者

回復 9# Hsieh

程式測試無錯誤
(說明見上)

謝謝H超版大

TOP

luke

中學生 Rank: 2

帖子: 140
主題: 37
精華: 0
積分: 193
點名: 0
作業系統: Windows XP
軟體版本: Office 2007
閱讀權限: 20
註冊時間: 2012-3-28
最後登錄: 2015-7-5

2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章

10^#

發表於 2012-4-4 20:58 | 只看該作者

回復 8# GBKEE

程式測試OK

小弟原本構思是從sheet2表去自訂5-10個資料區當作菜單, 每個資料區有10欄(A:J)以3-5列為乙區即每列10個儲存格*列數 (例如: AA資料區所代表AA01-AA30僅為該資料區所在代號位置), 也就是sheet2表A欄中有可能是空白, 文字公式來表示.

以下是測試(見第1點)說明:
1.假設sheet2表(檔案TEST5AA.rar), A欄BB資料區有5列,若把BB21和BB41即A6和A8同時改為空白, 拷貝過程中只會出現4列資料列, 無法拷貝5列資料列.

2.小弟轉述給register313中所提第3點“A欄若任一資料區所對應該區最後一列不是關鍵字, 該列將無法拷貝資料”是指H版大所給第1次程式有關鍵字限制,例如刪除如前項A8儲存格會造成無法拷貝該區(即sheet2表第8列)資料情形.

3.我想要的結果: 各資料區不管是何種格式不需去考慮關鍵字, 只需以sheet2表各資料區實際列數來拷貝即可.

謝謝GBKEE 版大

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

9^#

發表於 2012-4-4 18:09 | 只看該作者

回復 7# luke

Sub ex()
Dim Ay()
Set d = CreateObject("Scripting.Dictionary")
With sheet2
For Each a In .Range(.[A1], .[A65536].End(xlUp))
If IsEmpty(d(Left(a, 2))) Then
Set d(Left(a, 2)) = a.Resize(, 10)
Else
Set d(Left(a, 2)) = Union(d(Left(a, 2)), a.Resize(, 10))
End If
Next
End With
r = 11
With sheet1
.Range("A11").CurrentRegion.Clear
For Each a In .[B1:B5]
If d.exists(a.Offset(, -1).Value) = True Then
For i = 1 To a
d(a.Offset(, -1).Value).Copy .Cells(r, 1)
r = .Cells(11, 1).End(xlDown).Row + 1
Next
End If
Next
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

8^#

發表於 2012-4-4 12:35 | 只看該作者

回復 4# luke

Option Explicit
Sub Ex()
Dim E As Range, xf As Range, xi As Integer
With Sheet1
.[A11:J65536].Clear
For Each E In Sheet1.[a1:a5]
Set xf = Sheet2.[A:A].Find(E, lookat:=xlPart, After:=Sheet2.[A65536])
Set xf = xf.Resize(E.Cells(1, 4), 10)
For xi = 1 To E.Cells(1, 2)
With .Cells(Rows.Count, "A").End(xlUp).Offset(1)
If .Row < 11 Then xf.Copy Sheet1.[a11] Else xf.Copy .Cells
End With
Next
Next
End With
End Sub

複製代碼

TOP

luke

中學生 Rank: 2

帖子: 140
主題: 37
精華: 0
積分: 193
點名: 0
作業系統: Windows XP
軟體版本: Office 2007
閱讀權限: 20
註冊時間: 2012-3-28
最後登錄: 2015-7-5

2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章

7^#

發表於 2012-4-4 11:52 | 只看該作者

回復 6# register313

謝謝 register313, 程式測試OK

PS: Hsieh超版的#2程式SHEET2中 A欄有些問題,
1.若資料區無AA,BB...EE關鍵字會出現"沒有設定物件變數或With區塊變數"
2.若A欄中任一儲存格有"空白"儲存格會出現錯誤並顯示400
3.A欄若任一資料區所對應該區最後一列不是關鍵字, 該列將無法拷貝資料.

以上說明

TOP

register313

　頭銜: 麻辣路人甲

大學生 Rank: 4

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

6^#

發表於 2012-4-4 09:37 | 只看該作者

回復 4# luke

Hsieh超版#2之程式即是:直接判斷SHEET2 A欄有幾個AA,幾個BB...,作為列數之判斷
若資料區之資料確為AA01 AA02 AA03...BB01 BB01 BB03....之規則
請使用Hsieh超版#2之程式即可

若資料區之資料無規則,則可使用下列程式,但SHEET1 D1~D5必須輸入