[發問] 資料分類

jcchiang

檔案內Sheet1資料格式,要分類為Sheet2內的顯示方式,並計算出剩餘的時間
請問VB程式要如果撰寫,謝謝

資料分類.zip (2.78 KB)

下載次數: 9

2013-2-7 14:53

jcchiang

回復 5# Hsieh


    感謝版大的指導,測試後發現部份資料會造成程式判別異常,做部份的修改後,問題已得解決,謝謝

Hsieh

回復 4# jcchiang

1. Sub ex()
   
2. Dim Ay(), Ary(), A As Range, C As Range
   
3. With Sheet1
   
4. For Each A In .Range(.[B4], .[IV4].End(xlToLeft)).SpecialCells(xlCellTypeConstants)
   
5.     For Each C In .Range(.[A5], .[A5].End(xlDown))
   
6.       If InStr(C, "-") > 0 Then
   
7.         ar = Split(C, "-")
   
8.         Else
   
9.         ar = Split(C & "-(", "-")
   
10.       End If
    
11.       ReDim Ay(UBound(ar) + 4)
    
12.       Ay(0) = A: Ay(1) = ar(0): Ay(2) = Left(ar(1), InStr(ar(1), "(") - 1)
    
13.       If IsDate(.Cells(C.Row, A.Column)) Then
    
14.          Ay(3) = .Cells(C.Row, A.Column): Ay(4) = .Cells(C.Row, A.Column + 1)
    
15.          Ay(5) = Ay(4) - Date
    
16.          ElseIf InStr(.Cells(C.Row, A.Column), "~") > 0 Then
    
17.          Ay(3) = Evaluate(Replace(.Cells(C.Row, A.Column), "~", "+")) / 2
    
18.          Ay(4) = .Cells(C.Row, A.Column + 1): Ay(5) = Ay(3) - Ay(4)
    
19.          Else
    
20.          GoTo 10
    
21.       End If
    
22.     ReDim Preserve Ary(s)
    
23.     Ary(s) = Ay
    
24.     Erase Ay: s = s + 1
    
25. 10
    
26.     Next
    
27. Next
    
28. End With
    
29. Sheet2.UsedRange.Offset(2) = ""
    
30. Sheet2.[A3].Resize(s, 6) = Application.Transpose(Application.Transpose(Ary))
    
31. End Sub

複製代碼

jcchiang

回復 3# Hsieh


    感謝版大指導
       請問如果名稱中無"-"是否是在ar = Split(C, "-")裡多加一個判別
       那如果保養日期內為"---",且不將資料抓出,是否是在下列程式內多加一個Else判別資料
    If IsDate(.Cells(C.Row, A.Column)) Then
         Ay(3) = .Cells(C.Row, A.Column): Ay(4) = .Cells(C.Row, A.Column + 1)
         Ay(5) = Ay(4) - Date
         Else
         Ay(3) = Evaluate(Replace(.Cells(C.Row, A.Column), "~", "+")) / 2
         Ay(4) = .Cells(C.Row, A.Column + 1): Ay(5) = Ay(3) - Ay(4)
      End If
資料分類.zip (5.52 KB)

下載次數: 9

2013-2-7 17:26

Hsieh

回復 2# jcchiang

1. Sub ex()
   
2. Dim Ay(), Ary(), A As Range, C As Range
   
3. With Sheet1
   
4. For Each A In .Range(.[B4], .[IV4].End(xlToLeft)).SpecialCells(xlCellTypeConstants)
   
5.     For Each C In .Range(.[A5], .[A5].End(xlDown))
   
6.       ar = Split(C, "-")
   
7.       ReDim Ay(UBound(ar) + 4)
   
8.       Ay(0) = A: Ay(1) = ar(0): Ay(2) = Left(ar(1), InStr(ar(1), "(") - 1)
   
9.       If IsDate(.Cells(C.Row, A.Column)) Then
   
10.          Ay(3) = .Cells(C.Row, A.Column): Ay(4) = .Cells(C.Row, A.Column + 1)
    
11.          Ay(5) = Ay(4) - Date
    
12.          Else
    
13.          Ay(3) = Evaluate(Replace(.Cells(C.Row, A.Column), "~", "+")) / 2
    
14.          Ay(4) = .Cells(C.Row, A.Column + 1): Ay(5) = Ay(3) - Ay(4)
    
15.       End If
    
16.     ReDim Preserve Ary(s)
    
17.     Ary(s) = Ay
    
18.     Erase Ay: s = s + 1
    
19.     Next
    
20. Next
    
21. End With
    
22. Sheet2.UsedRange.Offset(2) = ""
    
23. Sheet2.[A3].Resize(s, 6) = Application.Transpose(Application.Transpose(Ary))
    
24. End Sub

複製代碼

jcchiang

有一點忘了提到
Sheet2內是空白的,每個項目是要從Sheet1 Copy進來