Board logo

標題: [求助]如何篩選較佳 [打印本頁]
作者: baa168    時間: 2012-2-11 19:41     標題: [求助]如何篩選較佳

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

以上
請協助
Thanks.
作者: GBKEE    時間: 2012-2-11 21:24

本帖最後由 GBKEE 於 2012-2-16 08:20 編輯

回復 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
複製代碼
作者: Hsieh    時間: 2012-2-11 21:33

本帖最後由 Hsieh 於 2012-2-11 21:36 編輯

回復 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
複製代碼
作者: register313    時間: 2012-2-11 21:34

本帖最後由 register313 於 2012-2-11 21:41 編輯

回復 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
複製代碼
作者: baa168    時間: 2012-2-11 22:48

感謝各位大大大力的協助...baa先消化一下...
作者: baa168    時間: 2012-2-15 21:25

Hsieh大跟register313大均出現錯誤訊息..不知是不是baa搞錯了.....
作者: baa168    時間: 2012-2-15 21:27

GBKEE大不知是否可以請您解釋一下程式內容...研究了兩天還是沒能了解...看來是超過了baa對VBA的程度了...感謝...
作者: baa168    時間: 2012-2-19 17:55

感謝GBKEE的協助...消化中...
作者: baa168    時間: 2012-3-15 18:25

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

感謝
作者: register313    時間: 2012-3-15 21:13

回復 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
複製代碼




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