Hsieh

¦^´_ 27# emma
¬O¤£¬O³o¼Ë®ÄªG?

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim Ar(), A As Range
   
3. If Target.Address <> "$B$1" Then Exit Sub
   
4. If Application.CountA(Range([A5], Cells(Rows.Count, 1))) > 0 Then
   
5.    For Each A In Range([A5], Cells(Rows.Count, 1).End(xlUp))
   
6.       ReDim Preserve Ar(s)
   
7.       Ar(s) = Application.Transpose(Application.Transpose(A.Resize(, 8)))
   
8.       s = s + 1
   
9.     Next
   
10. End If
    
11.    
    
12. With Sheet1
    
13. If Application.Count(.Range("B:B")) > 0 Then
    
14.    For Each A In .Range("B:B").SpecialCells(xlCellTypeConstants, 1)
    
15.    ReDim Preserve Ar(s)
    
16.    If A.Offset(, 8) = "V" And (A.Offset(, 9) > Date Or A.Offset(, 9) = "") And A > A.Offset(, 4) Then dot = Int(A / 1000) * 1000 Else dot = 0
    
17.    k = IIf(Target = "Á`©±", 10, 11)
    
18.       If A < A.Offset(, 4) Then
    
19.          m = "¹B¶O+¤âÄò¶O"
    
20.          ElseIf A.Offset(, 5) = "±À" And A > A.Offset(, 4) Then
    
21.          m = "§K¹B"
    
22.          ElseIf A.Offset(, 5) <> "±À" And A > A.Offset(, 4) Then
    
23.          m = "¹B¶O"
    
24.       End If
    
25.    Ar(s) = Array(A.Offset(, 2).Value, A.Value, A.Offset(, 3).Value, dot, A.Offset(, 12).Value, A.Offset(, k).Value, m, A.Offset(, 6).Value)
    
26.    s = s + 1
    
27.    Next
    
28. End If
    
29. End With
    
30. If s > 0 Then [A5].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
    
31. Range("A4").CurrentRegion.Sort key1:=[A4], Header:=xlYes
    
32. End Sub

½Æ»s¥N½X

VBAtest7.rar (19.28 KB)

¤U¸ü¦¸¼Æ: 12

2012-11-15 22:46

Hsieh

¦^´_ 30# emma

§Úı±o©pªº»Ý¨D¤£¹³¬O¬d¸ß¸ê®Æ
¤ñ¸û¹³¬O§â¸ê®ÆÀɤu§@ªíBÄ榳¼Æ値ªº¦C
¸g¹L³B²z«á¼g¤J¬d¸ß¤u§@ªí
¸Õ¸Õªþ¥ó
VBAtest7.rar (17.2 KB)

¤U¸ü¦¸¼Æ: 10

2012-11-17 21:43

Hsieh

¦^´_ 61# emma

¤U¸ü (62.08 KB)

2013-5-2 00:14

1. Function Read_Number(MyNum)
   
2. n = Right(MyNum, 4)
   
3. a = Array("¬B", "¦Ê", "¤d")
   
4. k = Len(n)
   
5. i = k
   
6. Do Until i = 0
   
7.   If Val(Mid(n, i, 1)) > 0 And i < k Then
   
8.      m = Mid(n, i, 1) & a(j): j = j + 1
   
9.      ElseIf i = k Then
   
10.      m = IIf(Val(Mid(n, i, 1)) = 0, "", Mid(n, i, 1))
    
11.      Else
    
12.      m = IIf(Val(Mid(n, i, 1)) = 0, "¹s", Mid(n, i, 1) & a(j))
    
13.      j = j + 1
    
14.   End If
    
15.   t = m & t
    
16.   i = i - 1
    
17. Loop
    
18. For i = 3 To 2 Step -1
    
19.   t = Replace(t, String(i, "¹s"), "¹s")
    
20. Next
    
21. s = Val(Left(MyNum, Len(MyNum) - k))
    
22. Read_Number = IIf(s = 0, "", Format(Val(Left(MyNum, Len(MyNum) - k)), "#,##0¸U")) & t
    
23. End Function

½Æ»s¥N½X