12
返回列表 上一主題 發帖

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

我是瑄

帖子
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以此類推..程式如下:
  1. Sub 按下按鈕()
  2. Dim y&
  3. With Sheets("B")
  4. y = .[Q65536].End(xlUp).Row 　 'Q欄最後一列
  5.        .Range("P2:P" & y).AutoFilter field:=1, Criteria1:="="
  6.        .Range("C2:C" & y).Copy Sheets("C").[A2]　 '貼C欄
  7.        .Range("A2:B" & y).Copy Sheets("C").[B2]　 '貼A~B欄
  8.        .Range("D2:H" & y).Copy Sheets("C").[D2]　 '貼D~H欄
  9.        .Range("Q2:Q" & y).Copy Sheets("C").[I2]　 '貼Q欄
  10.        .AutoFilterMode = False　 '取消篩選
  11. End With
  12. End Sub
複製代碼
小妹將按鈕移至表B(想在表B工作即可 不用一直切換)程式一樣用上述內容
但貼上後表C的格線會改變,所有的工作表都有固定的表格,只想貼上儲存格的內容不要改變工作表的格式,欄寬列高字型框線顏色...等
該如何設定?
我想在取消表B篩選後排序表C的A欄該如何寫入程式?
將命令按鈕從表C移至表B上述程式有需要修改的地方嗎?
收藏 分享

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
2#
發表於 2012-11-13 09:20 | 只看該作者
回復 1# 我是瑄
  1. Sub Test()
  2.     With Sheets("Sheet1")
  3.         ' .Range("A2:E2").Copy Sheets("Sheet2").[F2]
  4.         .Range("B1:B5").Copy Sheets("Sheet2").[G2]
  5.     End With
  6. End Sub

  8. Sub Test2()
  9.     With Sheets("Sheet1")
  10.         ' Sheets("Sheet2").[F5].Resize(, 5) = .Range("A5:E5").Value
  11.         ' Sheets("Sheet2").[F5].Resize(, 5) = .[A5:E5].Value
  12.         Sheets("Sheet2").[F5].Resize(5, 1) = .[B1:B5].Value
  13.     End With
  14. End Sub
複製代碼
Test() 會連同背景一併複製過來.

TOP

我是瑄

帖子
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

stillfish00

帖子
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?
  1. Sub 按下按鈕()
  2.     Dim y&
  3.     With Sheets("B")
  4.         y = .[Q65536].End(xlUp).Row    'Q欄最後一列
  5.         .Range("P2:P" & y).AutoFilter field:=1, Criteria1:="="
  6.         
  7.         '複製資料
  8.         Union(.Range("C2:C" & y), .Range("A2:B" & y), .Range("D2:H" & y), .Range("Q2:Q" & y)).Copy
  9.         '貼上值
  10.         Sheets("C").[A2].PasteSpecial Paste:=xlPasteValues
  11.       
  12.         .AutoFilterMode = False   '取消篩選
  13.     End With
  14. End Sub
複製代碼

TOP

我是瑄

帖子
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

我是瑄

帖子
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

Hsieh

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

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，(寫入目標位置可自行參考更改)
  1. Sub Input_Data()
  2. Dim Rng As Range
  3. With Sheets("B") '工作表B(資料區)
  4.   r = .[Q65536].End(xlUp).Row
  5.   If Application.CountBlank(.Range("P2:P" & r)) > 0 Then 'P欄空格數量大於0
  6.      Set Rng = .Range("P2:P" & r).SpecialCells(xlCellTypeBlanks) '找到P欄空格
  7.      ad = Split(Replace(Rng.Address(0, 0), "P", ""), ",") '取得空格的列位
  8.      ar = Array(3, 1, 2, 4, 5, 6, 7, 8, 17) '寫入的欄位順序
  9.      ReDim ay(UBound(ad) + 1, UBound(ar) + 1)
  10.      For j = 0 To UBound(ad)
  11.         For i = 0 To 8
  12.            ay(j, i) = .Cells(ad(j), ar(i)).Value '將資料暫存陣列中
  13.         Next
  14.      Next
  15.   End If
  16. End With
  17. With Sheets("A") '寫入的工作表
  18.    With .[A3].Resize(j, i)
  19.      .Value = ay '將陣列寫入目標區
  20.      .Sort key1:=.Cells(1, 1) 'A欄排序
  21.    End With
  22. End With
  23. End Sub
複製代碼
學海無涯_不恥下問

TOP

我是瑄

帖子
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

我是瑄

帖子
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

stillfish00

帖子
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

        靜思自在 : 君子立恆志，小人恆立志。
12
返回列表 上一主題