[µo°Ý] Bard code ¦C¦L°ÝÃD

PD961A

½Ð°Ý¥ý¶i
¦b"¸ê®Æ"¤u§@ªí¿é¤J©Ò»Ý±ø½X¦C¦L¸ê®Æ..
«ö¤U"¦C¦LÁä"­ì¥»¥i¥H¦Û°Ê­pºâ¨Ã¦C¦L..
½Ð°Ý²{¦b¨Ï¥Î¥u³Ñ³æ±i¸ê®ÆÅã¥Ü..µ{¦¡½X¬O§_¦³°ÝÃD»Ý­n­×¥¿?....ÁÂÁÂ

¤U¸ü (44.21 KB)

2010-8-18 10:06

GBKEE

¦^´_ 1# PD961A
­×§ï¤F¤@¤U ½Ð¸Õ¸Õ¬Ý

1. Sub Get_BardCode()
   
2.     Dim A As Range, d As Object, r%, k%, cnt%, i%, pnt%
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheet2
   
5.         For Each A In .[A1:D1]
   
6.             d(A.Value) = InputBox("½Ð¿é¤J" & A & "¹w³]¦r¤¸", "¹w³]¦r¤¸", IIf(A = .[C1], "", IIf(A = .[A1], "CC", Mid(A, 1, 1))))
   
7.         Next
   
8.         ay = d.items
   
9.         For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
10.             A.Offset(, 4) = InputBox("½Ð¿é¤J²Ä" & A.Row & "¦C" & A & "¤À¸Ë¶q", "¤À¸Ë¶q", 4)
    
11.             A.Offset(, 5) = IIf(A.Offset(, 1) Mod A.Offset(, 4) = 0, A.Offset(, 1) / A.Offset(, 4), Int(A.Offset(, 1) / A.Offset(, 4)) + 1)
    
12.         Next
    
13.         Sheet1.Range("B:C,F:G,J:K") = ""
    
14.         r = 2: k = 2
    
15.         For Each A In .Range(.[A2], .[A65536].End(xlUp))
    
16.             Ar = Array(A, A.Offset(, 4), A.Offset(, 2), A.Offset(, 3))
    
17.             For cnt = 1 To A.Offset(, 5)
    
18.                 With Sheet1.Cells(r, k).Resize(4, 1)
    
19.                     .Value = Application.Transpose(Ar)
    
20.                     For i = 0 To 3
    
21.                         .Offset(, 1).Cells(i + 1) = "*" & ay(i) & Ar(i) & "*"
    
22.                     Next
    
23.                 End With
    
24.                 k = k + 4
    
25.                 If k > 10 Then k = 2:   r = r + 5
    
26.             Next
    
27.         Next
    
28.     End With
    
29.     pnt = MsgBox("¬O§_¦C¦L" & Chr(10) & Chr(10) & "¬O    ¦C¦L" & Chr(10) & "§_    ¹wÄý" & Chr(10) & "¨ú®ø Â÷¶}", vbYesNoCancel)
    
30.     If pnt = 2 Then Exit Sub
    
31.     If pnt = 6 Then Sheet1.PrintOut '¦C¦L
    
32.     If pnt <> 6 Then Sheet1.PrintPreview '¹wÄý
    
33. End Sub

½Æ»s¥N½X

PD961A

¦^´_ 2# GBKEE


    ª©¥D
ÁÂÁ±z
®M¥Î«á...
¥¦ªº­pºâ¥\¯à...·|¨S¦³¿ìªk±N¨S¦³¾ã°£ªº³¡¥÷¤]·í¦¨¬O1±i±ø½X®æ¦¡

¤U¸ü (84.9 KB)

2010-8-18 17:28

¤U¸ü (32.3 KB)

2010-8-18 17:31

PD961A

¦^´_ 2# GBKEE


    ¥t¥~­ìµ{¦¡--¥»¨Ó´N¨S¦³¦h¤U­±³o­Ó¤p­p¨º¬OÁ{®É¥[¤W¥hªº
     ©Ò¥HÀ³¸Ó¤£¬O³o¸Ì¤£¹ï...
    ÁÂÁ±z....

¤U¸ü (28.15 KB)

2010-8-18 17:36

¤U¸ü (35.52 KB)

2010-8-18 17:36

¤U¸ü (93.42 KB)

2010-8-18 17:36

GBKEE

¦^´_ 4# PD961A
¼gµ{§Ç®É³Ì¦n¥[¤W Option Explicit ±j¨î«Å§iÅܼƠ ¦p¹Ï ·|¦Û°Ê¥[¤W
³]¥ß ÅÜ¼Æ ­^¤å¦r¤£­n¤Ó¬Û¦ü
¤Ö¤F¤@­Ók
If kcnt Mod 24 = 0 Or kcnt = Application.Sum(.Range(.[F2], .[F65536].End(xlUp))) Then
       If pnt <> 6 Then Sheet1.PrintPreview '¹wÄý
       If pnt = 0 Then pnt = MsgBox("¬O§_¦C¦L" & Chr(10) & "¬O    ¦C¦L" & Chr(10) & "§_    ¹wÄý" & Chr(10) & "¨ú®ø Â÷¶}", vbYesNoCancel)
       If pnt = 2 Then Exit Sub
       If pnt = 6 Then Sheet1.PrintOut '¦C¦L
       If kcnt < Application.Sum(.Range(.[F2], .[F65536].End(xlUp))) Then Sheet1.Columns("B:C") = "": Sheet1.Columns("F:G") = "": Sheet1.Columns("J:K") = ""
       r = 2: k = 2




   

¤U¸ü (35.81 KB)

2010-8-18 18:47

GBKEE

¦^´_ 3# PD961A
¥¦ªº­pºâ¥\¯à...·|¨S¦³¿ìªk±N¨S¦³¾ã°£ªº³¡¥÷¤]·í¦¨¬O1±i±ø½X®æ¦¡
³Ì«á¤@±i ¬O­n§À¼Æ¶Ü?

1. AR = Array(A, A.Offset(, 4), A.Offset(, 2), A.Offset(, 3))
   
2.     Do Until cnt > A.Offset(, 5)
   
3.         If cnt = A.Offset(, 5) And A.Offset(, 1) Mod A.Offset(, 4) <> 0 Then
   
4.             AR(1) = A.Offset(, 1) - A.Offset(, 4) * (cnt - 1)
   
5.         End If
   
6.         Sheet1.Cells(r, k).Resize(4, 1).Value = Application.Transpose(AR)
   
7.         For i = 0 To UBound(AR)
   
8.             Sheet1.Cells(r + i, k + 1) = "*" & ay(i) & AR(i) & "*"
   
9.         Next
   
10.         r = IIf(r > 37, 2, IIf(k = 10, r + 5, r))
    
11.         k = IIf(r > 37 Or k = 10, 2, k + 4)
    
12.         kcnt = kcnt + 1
    
13.         If kcnt Mod 24 = 0 Or kcnt = Application.Sum(.Range(.[F2], .[F65536].End(xlUp))) Then
    
14.             If pnt <> 6 Then Sheet1.PrintPreview '¹wÄý
    
15.             If pnt = 0 Then pnt = MsgBox("¬O§_¦C¦L" & Chr(10) & "¬O    ¦C¦L" & Chr(10) & "§_    ¹wÄý" & Chr(10) & "¨ú®ø Â÷¶}", vbYesNoCancel)
    
16.             If pnt = 2 Then Exit Sub
    
17.             If pnt = 6 Then Sheet1.PrintOut '¦C¦L
    
18.             If kcnt < Application.Sum(.Range(.[F2], .[F65536].End(xlUp))) Then Sheet1.Columns("B:C") = "": Sheet1.Columns("F:G") = "": Sheet1.Columns("J:K") = ""
    
19.             r = 2: k = 2
    
20.         End If
    
21.         cnt = cnt + 1
    
22.     Loop

½Æ»s¥N½X

PD961A

¦^´_ 6# GBKEE


    ÁÂÁª©¥D
¨S¿ù..¬O­n§À¼Æ¤]­pºâ¥X¦¨1±i
10KG=2±i4KG+1±i2KG

ÁÂÁ±z

¤U¸ü (17.13 KB)

2010-8-19 07:22

GBKEE

¦^´_ 7# PD961A
³o¨Çµ{¦¡½X ´N¬O§PÂ_³Ì«á¤@±i¬O§_¬O¾ã¼Æ
03.        If cnt = A.Offset(, 5) And A.Offset(, 1) Mod A.Offset(, 4) <> 0 Then
04.            AR(1) = A.Offset(, 1) - A.Offset(, 4) * (cnt - 1)
05.        End If
ªþ¹Ï ¬O¤°»ò°ÝÃD

PD961A

¦^´_ 8# GBKEE


    §â±zªºµ{¦¡½X±a¶i¥h¤F...
±o¨ì´N¬O³o¼Ëªºµe­±....

GBKEE

¦^´_ 9# PD961A
¤W«hªºµ{¦¡½X,¬O­nµ¹§A®M¥Î¨ìGet_BardCode ¤¤¥Îªº ,§AÀ³¸Ó¬ÝªºÀ´ ­þ¥u¬O³¡¤Àªºµ{¦¡½X.
§A¨S¦³µ¹µ{§Ç¦WºÙ
Sub ????()   
'
'
End Sub

1. Sub Get_BardCode()
   
2.     Dim A As Range, d As Object, r%, k%, cnt%, i%, pnt%
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheet2
   
5.         For Each A In .[A1:D1]
   
6.             d(A.Value) = InputBox("½Ð¿é¤J" & A & "¹w³]¦r¤¸", "¹w³]¦r¤¸", IIf(A = .[C1], "", IIf(A = .[A1], "CC", Mid(A, 1, 1))))
   
7.         Next
   
8.         ay = d.items
   
9.         For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
10.             A.Offset(, 4) = InputBox("½Ð¿é¤J²Ä" & A.Row & "¦C" & A & "¤À¸Ë¶q", "¤À¸Ë¶q", 4)
    
11.             A.Offset(, 5) = IIf(A.Offset(, 1) Mod A.Offset(, 4) = 0, A.Offset(, 1) / A.Offset(, 4), Int(A.Offset(, 1) / A.Offset(, 4)) + 1)
    
12.         Next
    
13.         Sheet1.Range("B:C,F:G,J:K") = ""
    
14.         r = 2: k = 2
    
15.         kcnt = 1
    
16.         For Each A In .Range(.[A2], .[A65536].End(xlUp))
    
17.            AR = Array(A, A.Offset(, 4), A.Offset(, 2), A.Offset(, 3))
    
18.             cnt = 1
    
19.             Do Until cnt > A.Offset(, 5)
    
20.                 If cnt = A.Offset(, 5) And A.Offset(, 1) Mod A.Offset(, 4) <> 0 Then
    
21.                     AR(1) = A.Offset(, 1) - A.Offset(, 4) * (cnt - 1)
    
22.                 End If
    
23.                 Sheet1.Cells(r, k).Resize(4, 1).Value = Application.Transpose(AR)
    
24.                 For i = 0 To UBound(AR)
    
25.                     Sheet1.Cells(r + i, k + 1) = "*" & ay(i) & AR(i) & "*"
    
26.                 Next
    
27.                 r = IIf(r > 37, 2, IIf(k = 10, r + 5, r))
    
28.                 k = IIf(r > 37 Or k = 10, 2, k + 4)
    
29.                 If kcnt Mod 24 = 0 Or kcnt = Application.Sum(.Range(.[F2], .[F65536].End(xlUp))) Then
    
30.                     If pnt <> 6 Then Sheet1.PrintPreview '¹wÄý
    
31.                     If pnt = 0 Then pnt = MsgBox("¬O§_¦C¦L" & Chr(10) & "¬O    ¦C¦L" & Chr(10) & "§_    ¹wÄý" & Chr(10) & "¨ú®ø Â÷¶}", vbYesNoCancel)
    
32.                     If pnt = 2 Then Exit Sub
    
33.                     If pnt = 6 Then Sheet1.PrintOut '¦C¦L
    
34.                     If kcnt < Application.Sum(.Range(.[F2], .[F65536].End(xlUp))) Then Sheet1.Columns("B:C") = "": Sheet1.Columns("F:G") = "": Sheet1.Columns("J:K") = ""
    
35.                     r = 2: k = 2
    
36.                 End If
    
37.                 kcnt = kcnt + 1
    
38.                 cnt = cnt + 1
    
39.             Loop
    
40.         Next
    
41.     End With
    
42. End Sub

½Æ»s¥N½X