麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 關於巨集程式修改問題 [打印本頁]

作者: 我是瑄 時間: 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上述程式有需要修改的地方嗎?

作者: c_c_lai 時間: 2012-11-13 09:20

回復 1# 我是瑄

Sub Test()
With Sheets("Sheet1")
' .Range("A2:E2").Copy Sheets("Sheet2").[F2]
.Range("B1:B5").Copy Sheets("Sheet2").[G2]
End With
End Sub
Sub Test2()
With Sheets("Sheet1")
' Sheets("Sheet2").[F5].Resize(, 5) = .Range("A5:E5").Value
' Sheets("Sheet2").[F5].Resize(, 5) = .[A5:E5].Value
Sheets("Sheet2").[F5].Resize(5, 1) = .[B1:B5].Value
End With
End Sub

複製代碼

Test() 會連同背景一併複製過來.

作者: 我是瑄 時間: 2012-11-13 14:53

回復 2# c_c_lai

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

作者: stillfish00 時間: 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

複製代碼

作者: 我是瑄 時間: 2012-11-18 04:41

回復 4# stillfish00

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

作者: 我是瑄 時間: 2012-11-18 04:59

回復 4# stillfish00

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

作者: Hsieh 時間: 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

複製代碼

作者: 我是瑄 時間: 2012-11-23 20:48

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

作者: 我是瑄 時間: 2012-11-23 21:08

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

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

作者: stillfish00 時間: 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
或者看別人有沒有更簡潔的寫法

作者: 我是瑄 時間: 2012-11-28 20:08

回復 10# stillfish00

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

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