帖子: 234
主題: 19
精華: 0
積分: 276
點名: 0
作業系統: Windows XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2013-1-7
最後登錄: 2021-10-7

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2013-2-7 14:55 | 只看該作者

[發問] 資料分類

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

資料分類.zip (2.78 KB)

樓主熱帖

jcchiang

中學生 Rank: 2

帖子: 234
主題: 19
精華: 0
積分: 276
點名: 0
作業系統: Windows XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2013-1-7
最後登錄: 2021-10-7

6^#

發表於 2013-2-8 11:14 | 只看該作者

回復 5# Hsieh

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

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 277
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-12-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

5^#

發表於 2013-2-7 18:49 | 只看該作者

回復 4# jcchiang

Sub ex()
Dim Ay(), Ary(), A As Range, C As Range
With Sheet1
For Each A In .Range(.[B4], .[IV4].End(xlToLeft)).SpecialCells(xlCellTypeConstants)
For Each C In .Range(.[A5], .[A5].End(xlDown))
If InStr(C, "-") > 0 Then
ar = Split(C, "-")
Else
ar = Split(C & "-(", "-")
End If
ReDim Ay(UBound(ar) + 4)
Ay(0) = A: Ay(1) = ar(0): Ay(2) = Left(ar(1), InStr(ar(1), "(") - 1)
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
ElseIf InStr(.Cells(C.Row, A.Column), "~") > 0 Then
Ay(3) = Evaluate(Replace(.Cells(C.Row, A.Column), "~", "+")) / 2
Ay(4) = .Cells(C.Row, A.Column + 1): Ay(5) = Ay(3) - Ay(4)
Else
GoTo 10
End If
ReDim Preserve Ary(s)
Ary(s) = Ay
Erase Ay: s = s + 1
10
Next
Next
End With
Sheet2.UsedRange.Offset(2) = ""
Sheet2.[A3].Resize(s, 6) = Application.Transpose(Application.Transpose(Ary))
End Sub

複製代碼

學海無涯_不恥下問

TOP

jcchiang

中學生 Rank: 2

帖子: 234
主題: 19
精華: 0
積分: 276
點名: 0
作業系統: Windows XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2013-1-7
最後登錄: 2021-10-7

4^#

發表於 2013-2-7 17:27 | 只看該作者

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

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 277
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-12-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

3^#

發表於 2013-2-7 16:30 | 只看該作者

回復 2# jcchiang

Sub ex()
Dim Ay(), Ary(), A As Range, C As Range
With Sheet1
For Each A In .Range(.[B4], .[IV4].End(xlToLeft)).SpecialCells(xlCellTypeConstants)
For Each C In .Range(.[A5], .[A5].End(xlDown))
ar = Split(C, "-")
ReDim Ay(UBound(ar) + 4)
Ay(0) = A: Ay(1) = ar(0): Ay(2) = Left(ar(1), InStr(ar(1), "(") - 1)
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
ReDim Preserve Ary(s)
Ary(s) = Ay
Erase Ay: s = s + 1
Next
Next
End With
Sheet2.UsedRange.Offset(2) = ""
Sheet2.[A3].Resize(s, 6) = Application.Transpose(Application.Transpose(Ary))
End Sub

複製代碼

學海無涯_不恥下問

TOP

jcchiang

中學生 Rank: 2

帖子: 234
主題: 19
精華: 0
積分: 276
點名: 0
作業系統: Windows XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2013-1-7
最後登錄: 2021-10-7

2^#

發表於 2013-2-7 14:59 | 只看該作者

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

TOP