帖子: 8
主題: 2
精華: 0
積分: 16
點名: 0
作業系統: WIN7
軟體版本: OFFICE2010
閱讀權限: 10
註冊時間: 2012-11-9
最後登錄: 2012-11-28

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2012-11-13 08:18 | 只看該作者

[發問] 關於巨集程式修改問題

本帖最後由我是瑄於 2012-11-13 08:21 編輯

小妹的EXCEL裡有6個工作表以A~E稱之
我在表C設按鈕,點擊後,會到表B尋找Q欄的最後一列(資料數變動的所以最後一列不固定)
篩選P欄為空格的,將C欄複製貼上表A的A3以此類推..程式如下:

Sub 按下按鈕()
Dim y&
With Sheets("B")
y = .[Q65536].End(xlUp).Row 　 'Q欄最後一列
.Range("P2:P" & y).AutoFilter field:=1, Criteria1:="="
.Range("C2:C" & y).Copy Sheets("C").[A2]　 '貼C欄
.Range("A2:B" & y).Copy Sheets("C").[B2]　 '貼A~B欄
.Range("D2:H" & y).Copy Sheets("C").[D2]　 '貼D~H欄
.Range("Q2:Q" & y).Copy Sheets("C").[I2]　 '貼Q欄
.AutoFilterMode = False　 '取消篩選
End With
End Sub

複製代碼

小妹將按鈕移至表B(想在表B工作即可不用一直切換)程式一樣用上述內容
但貼上後表C的格線會改變,所有的工作表都有固定的表格,只想貼上儲存格的內容不要改變工作表的格式,欄寬列高字型框線顏色...等
該如何設定?
我想在取消表B篩選後排序表C的A欄該如何寫入程式?
將命令按鈕從表C移至表B上述程式有需要修改的地方嗎?

我是瑄

小學生 Rank: 1

帖子: 8
主題: 2
精華: 0
積分: 16
點名: 0
作業系統: WIN7
軟體版本: OFFICE2010
閱讀權限: 10
註冊時間: 2012-11-9
最後登錄: 2012-11-28

11^#

發表於 2012-11-28 20:08 | 只看該作者

回復 10# stillfish00

感恩大大我會測試看看的!!

TOP

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

10^#

發表於 2012-11-27 19:49 | 只看該作者

回復 9# 我是瑄
學習中 , 看起來應該是下面這行的問題
ad = Split(Replace(Rng.Address(0, 0), "P", ""), ",") '取得空格的列位
如果Rng中有連續的儲存格 , Address會以 ":" 合起來 , 不會一個個逗號分隔表示
試試看把上面那行改為底下的code:
      ReDim ad(Rng.Count - 1)
      k = 0
      For Each area In Rng.Areas
         For Each acell In area
            ad(k) = acell.Row
            k = k + 1
         Next
      Next
或者看別人有沒有更簡潔的寫法

TOP

我是瑄

小學生 Rank: 1

帖子: 8
主題: 2
精華: 0
積分: 16
點名: 0
作業系統: WIN7
軟體版本: OFFICE2010
閱讀權限: 10
註冊時間: 2012-11-9
最後登錄: 2012-11-28

9^#

發表於 2012-11-23 21:08 | 只看該作者

本帖最後由我是瑄於 2012-11-23 21:10 編輯

回復 8# Hsieh
大大我將程式寫入按鈕巨集裡執行時
ay(j, i) = .Cells(ad(j), ar(i)).Value '將資料暫存陣列中
這行說資料型態不符,請問一下是甚麼原因呢???

TOP

我是瑄

小學生 Rank: 1

帖子: 8
主題: 2
精華: 0
積分: 16
點名: 0
作業系統: WIN7
軟體版本: OFFICE2010
閱讀權限: 10
註冊時間: 2012-11-9
最後登錄: 2012-11-28

8^#

發表於 2012-11-23 20:48 | 只看該作者

回復 7# Hsieh
謝謝大大,大大可能看錯了~我敘述是B工作表為報表,C工作表為篩選b表所選取的資料貼上
但是大大有標示出工作表可代換,所以是沒有問題的^^只是解釋一下!感恩大大的幫忙唷,我立刻試試看如果有問題再回復大大!!

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

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

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

7^#

發表於 2012-11-18 10:31 | 只看該作者

回復 6# 我是瑄
根據1#敘述寫入的目標工作表是工作表A，但程式碼卻是寫入到工作表C
以下程式碼是依據1#敘述不對工作表B進行篩選動作，
直接將P欄空格寫入工作表A，(寫入目標位置可自行參考更改)

Sub Input_Data()
Dim Rng As Range
With Sheets("B") '工作表B(資料區)
r = .[Q65536].End(xlUp).Row
If Application.CountBlank(.Range("P2:P" & r)) > 0 Then 'P欄空格數量大於0
Set Rng = .Range("P2:P" & r).SpecialCells(xlCellTypeBlanks) '找到P欄空格
ad = Split(Replace(Rng.Address(0, 0), "P", ""), ",") '取得空格的列位
ar = Array(3, 1, 2, 4, 5, 6, 7, 8, 17) '寫入的欄位順序
ReDim ay(UBound(ad) + 1, UBound(ar) + 1)
For j = 0 To UBound(ad)
For i = 0 To 8
ay(j, i) = .Cells(ad(j), ar(i)).Value '將資料暫存陣列中
Next
Next
End If
End With
With Sheets("A") '寫入的工作表
With .[A3].Resize(j, i)
.Value = ay '將陣列寫入目標區
.Sort key1:=.Cells(1, 1) 'A欄排序
End With
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

我是瑄

小學生 Rank: 1

帖子: 8
主題: 2
精華: 0
積分: 16
點名: 0
作業系統: WIN7
軟體版本: OFFICE2010
閱讀權限: 10
註冊時間: 2012-11-9
最後登錄: 2012-11-28

6^#

發表於 2012-11-18 04:59 | 只看該作者

回復 4# stillfish00

真是抱歉已經超過3分鐘,所以只能回復第二次,最上面的程式我有寫錯,因為表C後來將按鈕移至表B所以資料從
A2開始標題列為A1~I1 所以最上面複製貼上的應該為[A1]才對~至於大大說的排序因為是文字所以升降並沒有太大的差別
主要是要將相同的資料排在一起,好讓我做下一個工作表

TOP

我是瑄

小學生 Rank: 1

帖子: 8
主題: 2
精華: 0
積分: 16
點名: 0
作業系統: WIN7
軟體版本: OFFICE2010
閱讀權限: 10
註冊時間: 2012-11-9
最後登錄: 2012-11-28

5^#

發表於 2012-11-18 04:41 | 只看該作者

回復 4# stillfish00

謝謝大大,c表的A欄為文字,標題列在列1,那這樣應該怎麼寫?

TOP

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

4^#

發表於 2012-11-14 01:29 | 只看該作者

回復 3# 我是瑄
以下是只貼上值 , 不含格式
要再排序表C的A欄 , 要先知道A欄實際資料是文字/數字? 要做升序/降序? 及標題列是在列1 or 列2?

Sub 按下按鈕()
Dim y&
With Sheets("B")
y = .[Q65536].End(xlUp).Row 'Q欄最後一列
.Range("P2:P" & y).AutoFilter field:=1, Criteria1:="="
'複製資料
Union(.Range("C2:C" & y), .Range("A2:B" & y), .Range("D2:H" & y), .Range("Q2:Q" & y)).Copy
'貼上值
Sheets("C").[A2].PasteSpecial Paste:=xlPasteValues
.AutoFilterMode = False '取消篩選
End With
End Sub

複製代碼

TOP

我是瑄

小學生 Rank: 1

帖子: 8
主題: 2
精華: 0
積分: 16
點名: 0
作業系統: WIN7
軟體版本: OFFICE2010
閱讀權限: 10
註冊時間: 2012-11-9
最後登錄: 2012-11-28

3^#

發表於 2012-11-13 14:53 | 只看該作者

回復 2# c_c_lai

謝謝大大,但是我只要複製值不要連同複製格式,TEXT應該不適用^^不過還是謝謝大大的幫忙
由於我的資料為變數這個月為85筆,下個月可能降至45筆所以我的程式內容要先找到最後一列
設Y,然後再帶入公式

TOP

[發問] 關於巨集程式修改問題

[發問] 關於巨集程式修改問題

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]