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

我是瑄

小妹的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

回復 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
   
7. 
   
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() 會連同背景一併複製過來.

我是瑄

回復 2# c_c_lai


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

stillfish00

回復 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

複製代碼

我是瑄

回復 4# stillfish00

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

我是瑄

回復 4# stillfish00


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

Hsieh

回復 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

複製代碼

我是瑄

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

我是瑄

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

stillfish00

回復 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
或者看別人有沒有更簡潔的寫法