多頁出貨資料如何在新分頁依範圍日期選出排列呢? 依範圍日期選出排列

jimmy510

請教各位大大:
我在EXCEL資料裡面有多個分頁如下

下載 (75.09 KB)

2012-7-16 09:40

下載 (74.51 KB)

2012-7-16 09:41

有辦法可以在新的分頁裡面依指定的日期範圍將多個分頁內符合的資料回傳到新分頁中嗎?
起來的校果如下面的排列..

下載 (80.7 KB)

2012-7-16 09:44

請精通EXCELL的大大幫我解答,謝謝..

jimmy510

一個多月了~怕各位大大太忙沒看到~~頂一下^^

jimmy510

回復 2# jimmy510
範例檔如壓縮檔,請問可以在新分頁中將某區段日期的所有分頁資料排列出來嗎?例如我要選99/6/1至99/9/1所有的出貨資料..
煩請資深的版友幫我一下~謝謝..
文件.rar (15.36 KB)

下載次數: 7

2012-8-23 13:24

jimmy510

抱歉囉~再頂一下~我文件已經上傳了~有空的版友幫忙一下吧^^~謝謝..

Hsieh

回復 4# jimmy510
不知道是不是這個意思
彙整資料又有計算欄位可能用VBA比較單純

1. Sub ex()
   
2. Dim ar()
   
3. ReDim Preserve ar(s)
   
4. ar(s) = Array("尺寸", "日期", "數量", "單價", "總額", "備註")
   
5. s = 1
   
6. st = InputBox("輸入起始日期", , Format(DateAdd("M", -12, Date), "e/m/d"))
   
7. st1 = InputBox("輸入起始日期", , Format(Date, "e/m/d"))
   
8. For Each sh In Sheets
   
9. With sh
   
10.    If .Name Like "刀模*" Then
    
11.      For Each a In .Range(.[A3], .Cells(.Rows.Count, 1).End(xlUp))
    
12.        If CDate(a) >= CDate(st) And CDate(a) <= CDate(st1) Then
    
13.           ReDim Preserve ar(s)
    
14.           ar(s) = Array(.[A1].Value, a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 1).Value * a.Offset(, 2).Value, a.Offset(, 3).Value)
    
15.           s = s + 1
    
16.        End If
    
17.      Next
    
18.     End If
    
19. End With
    
20. Next
    
21. If s > 1 Then
    
22. With Worksheets.Add(after:=Sheets(Sheets.Count))
    
23. .[A1].Resize(s, 6) = Application.Transpose(Application.Transpose(ar))
    
24. End With
    
25. Else
    
26. MsgBox "沒有符合資料"
    
27. End If
    
28. End Sub

複製代碼

jimmy510

回復 5# Hsieh


    感謝版大的解答~我測試後真的是我想要的東西~謝謝..可是有些小問題想請教,當我將這個VBA放到別的活頁簿使用時巨集再跑時有發生錯誤,執行偵錯時跑到
If CDate(a) >= CDate(st) And CDate(a) <= CDate(st1) Then 錯誤,請問有哪邊需要調整嗎?

Hsieh

ˋ回復 6# jimmy510


    你的日期並非正確的日期格式
例如99/9/3這會被認為是1999/9/3
可能是你的日期超出系統許可日期範圍
導致Cdate函數出錯
請上傳錯誤檔案以釐清原因

jimmy510

回復 7# Hsieh


    版大你好,附上有問題的資料,麻煩你幫我看一下,我有看過日期設定應該都沒錯.. 美林.rar (28.04 KB)

下載次數: 4

2012-9-6 14:45

Hsieh

回復 8# jimmy510



    當工作表A3以下沒有日期資料才會出錯

1. Sub 出貨查詢()
   
2. Dim ar()
   
3. ReDim Preserve ar(s)
   
4. ar(s) = Array("尺寸", "日期", "數量", "單價", "總額", "備註")
   
5. s = 1
   
6. st = InputBox("輸入起始日期", , Format(DateAdd("M", -12, Date), "e/m/d"))
   
7. st1 = InputBox("輸入起始日期", , Format(Date, "e/m/d"))
   
8. For Each sh In Sheets
   
9. With sh
   
10.    If .Name Like "刀模*" Then
    
11.      For Each a In .Range(.[A3], .Cells(.Rows.Count, 1).End(xlUp))
    
12.      If Not IsDate(a) Then GoTo 10
    
13.        If CDate(a) >= CDate(st) And CDate(a) <= CDate(st1) Then
    
14.           ReDim Preserve ar(s)
    
15.           ar(s) = Array(.[A1].Value, a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 1).Value * a.Offset(, 2).Value, a.Offset(, 3).Value)
    
16.           s = s + 1
    
17.        End If
    
18. 10
    
19.      Next
    
20.     End If
    
21. End With
    
22. Next
    
23. If s > 1 Then
    
24. With Worksheets.Add(after:=Sheets(Sheets.Count))
    
25. .[A1].Resize(s, 6) = Application.Transpose(Application.Transpose(ar))
    
26. End With
    
27. Else
    
28. MsgBox "沒有符合資料"
    
29. End If
    
30. End Sub

複製代碼

jimmy510

感謝版大~~解決了~~謝謝你的幫忙