[求助]如何篩選較佳

baa168

Dear All:
       1.將A區每個月最後一週提出如黃色標示部份
           2.將日期去年份顯示

以上
請協助
Thanks.

register313

回復 9# baa168

1. Sub AA()
   
2. Sheets("Sheet2").Columns("A:B") = ""
   
3. Sheets("Sheet2").[A3] = "日期": Sheets("Sheet2").[B3] = "內容"
   
4. T = 4
   
5. With Sheets("Sheet1")
   
6. For R = 4 To .Range("A65536").End(xlUp).Row
   
7.   If (Month(.Cells(R, "A")) <> Month(.Cells(R + 1, "A"))) Or (R = .Range("A65536").End(xlUp).Row) Then
   
8.      Sheets("Sheet2").Cells(T, "A") = Right(.Cells(R, "A"), Len(.Cells(R, "A")) - 5)
   
9.      Sheets("Sheet2").Cells(T, "A").NumberFormatLocal = "m/d;@"
   
10.      Sheets("Sheet2").Cells(T, "B") = .Cells(R, "B")
    
11.      T = T + 1
    
12.   End If
    
13. Next R
    
14. End With
    
15. End Sub

複製代碼

baa168

請教各位先進
若要將所篩選資料顯示至Sheet2，該如何進行

感謝

baa168

感謝GBKEE的協助...消化中...

baa168

GBKEE大不知是否可以請您解釋一下程式內容...研究了兩天還是沒能了解...看來是超過了baa對VBA的程度了...感謝...

baa168

Hsieh大跟register313大均出現錯誤訊息..不知是不是baa搞錯了.....

baa168

感謝各位大大大力的協助...baa先消化一下...

register313

回復 1# baa168

1. Sub AA()
   
2. Columns("G:H") = ""
   
3. [G3] = "日期": [H3] = "內容"
   
4. T = 4
   
5. For R = 4 To Range("A65536").End(xlUp).Row
   
6.   If (Month(Cells(R, "A")) <> Month(Cells(R + 1, "A"))) Or (R = Range("A65536").End(xlUp).Row) Then
   
7.      Cells(T, "G") = Right(Cells(R, "A"), Len(Cells(R, "A")) - 5)
   
8.      Cells(T, "G").NumberFormatLocal = "m/d;@"
   
9.      Cells(T, "H") = Cells(R, "B")
   
10.      T = T + 1
    
11.   End If
    
12. Next R
    
13. End Sub

複製代碼

Hsieh

回復 1# baa168

1. Sub nn()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. d("日期") = Array("日期", "內容")
   
4. For Each a In Range("A4", [A65536].End(xlUp))
   
5. mystr = Format(a, "yyyymm")
   
6.   d(mystr) = Array(a.Value, a.Offset(, 1).Value)
   
7. Next
   
8. [G:H] = ""
   
9. [G3].Resize(d.Count, 2) = Application.Transpose(Application.Transpose(d.items))
   
10. End Sub

複製代碼

GBKEE

回復 1# baa168
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim xR As Integer, xMonth As Integer, Ar(), xAr As Integer
   
4.     xR = 4                                           '第4列
   
5.     ReDim Ar(1, xAr)                                 '重新宣告  AR(0 TO 1,0) 二維陣列
   
6.     Ar(0, xAr) = "日期"                              'Ar(0, 0) = "日期"
   
7.     Ar(1, xAr) = "內容"                              'Ar(1, 0) = "內容"
   
8.     With ActiveSheet
   
9.         xMonth = Month(.Cells(xR, "A"))               '取得 A4月份
   
10.         Do While .Cells(xR, "A") <> ""                '執行迴圈條件  不是空白的儲存格
    
11.             If Month(.Cells(xR + 1, "A")) <> xMonth Or .Cells(xR + 1, "A") = "" Then
    
12.                 '下一列的月份<>這一列的月份  或是  下一列是空白
    
13.                  xMonth = Month(.Cells(xR + 1, "A"))    '更改月份的數值
    
14.                 xAr = xAr + 1                          '二維陣列 的第二維再加一個元素
    
15.                 ReDim Preserve Ar(1, xAr)              '重新宣告  AR(0 TO 1,xAr) 二維陣列
    
16.                 'Preserve 選擇性引數。當改變原有陣列最後一維的大小時，仍然保有原來的資料的關鍵字。
    
17.                 Ar(0, xAr) = .Cells(xR, "A")           'Ar(0, xAr) = "日期"
    
18.                 Ar(1, xAr) = .Cells(xR, "B")           'Ar(0, xAr) = "內容"
    
19.             End If
    
20.             xR = xR + 1                                 '再往下一列
    
21.         Loop
    
22.         .Range("G3").CurrentRegion = "" 'CurrentRegion 屬性目前區域是指以任意空白列及空白欄的組合為邊界的範圍。唯讀。
    
23.         .Range("G3").Resize(xAr + 1, 2) = Application.Transpose(Ar)   '運用工作表函數 Transpose (轉置) Ar 陣列
    
24.         .Range("G3").Resize(xAr + 1).NumberFormatLocal = "m/d;@"      ' 制訂儲存格 日期格式
    
25.     End With
    
26. End Sub

複製代碼