[µo°Ý] ½Ð±ÐÀx¦s®æ¾e¨ú¤å¦r¨Ã§PÂ_ªº°ÝÃD

sujane0701

EXA.rar (2.27 KB)

¤U¸ü¦¸¼Æ: 25

2011-3-21 03:14

°ÝÃD¤£®e©ö¥Î¯Â¤å¦r»¡©ú,½Ð¤j¤j­Ì¬ÝÀɮפº®e¸û®e©ö©ú¥Õ¤p§Ìªº°ÝÃD

ANGELA

¦pªG¥u­n¥h°£ªÅ¥Õ¥H«áªº¤å¦r¥Î¸ê®Æ­åªR§Y¥i,
¥Î¨ç¼Æ­n°µ¨ì§Aªº­n¨D¤Ó³Â·Ð¤F,­n©w¸q¤Ó¦h¦WºÙ,ÁÙ¬O¼vÀ³«e½ú­Ì¤@¦AÁ¿ªº¥¿³W¤Æ¸ê®Æ®w.¸û¹ê¦b.

sujane0701

ÁÂÁª©¥D«ü¾É
¤ñ¸ûµL©`ªº¬O,¸ê®Æ¨Ó·½¬O¥Ñ«È¤á´£¨Ñªº ¤@¤p¬q ¤@¤p¬q TXT¤å¦rÀÉ,«o¥]§t¤j¶q°T®§,¤p§Ì¤]«Ü­W´o
¨º¯à§_½Ð±Ð,¦pªG³æ¤@Àx¦s®æ¤ºEF000~EF003,¬O§_¦³¨ç¼Æ¥i¥H±o¥Xµ²ªGEF000,EF001,EF002,EF003 ?

Hsieh

¦^´_ 3# sujane0701


    ³oºØ¤£©w¼Æ­Èªº¸ê®Æ¤À¸Ñ¡A­n¥Î¤º«Ø¨ç¼Æ¹F¦¨¬O¦³§xÃøªº
«Øij¨Ï¥ÎVBA¼g¦Û©w¸q¨ç¼Æ¨Ó¸Ñ¨M

¸Õ¸Õ¦Û©w¸q¨ç¼Æ
EXA.rar (8.37 KB)

¤U¸ü¦¸¼Æ: 16

2011-3-23 12:03

ANGELA

¦^´_ 3# sujane0701


    °Ñ¦Ò¬Ý¬Ý
    ©w¸q¦WºÙ
     BX =MID(Sheet2!$C1,3,3)
    EX =IF(ISNUMBER(FIND("~",Sheet2!$C1)),MID(Sheet2!$C1,7,3),Sheet2!$C1)
    BEX =IF(LEN(ex)=2,ex-RIGHT(bx,2),ex-bx)
    EXA.zip (4.59 KB)

¤U¸ü¦¸¼Æ: 9

2011-3-23 10:40

   ³oºØ°ÝÃD¥ÎVBA·|²z·Q¨Ç.

GBKEE

±N¸ê®ÆÅã¥Ü©ó Sheet2

1. Sub Ex()
   
2.     Dim Ar, Ar1, E, A, R As Integer, C As Integer, S As Integer
   
3.     R = 1
   
4.     C = 1
   
5.     Sheet2.Cells = ""
   
6.     For Each E In Sheet1.Range("A1:C" & Sheet1.Range("A1").End(xlDown).Row).Rows
   
7.         Sheet2.Cells(R, C) = E.Cells(1, 1) & "-" & E.Cells(1, 2)
   
8.         Ar = Split(E.Cells(1, 3), " ")
   
9.         If InStr(Ar(0), ",") Then
   
10.             Ar = Split(Ar(0), ",")
    
11.             For Each A In Ar
    
12.                 If InStr(A, "~") Then
    
13.                     Ar1 = Split(A, "~")
    
14.                     R = R + 1
    
15.                     S = Ar1(1) - Right(Ar1(0), Len(Ar1(1))) + 1
    
16.                     Sheet2.Cells(R, C) = Ar1(0)
    
17.                     Sheet2.Cells(R, C).AutoFill Sheet2.Cells(R, C).Resize(S)
    
18.                     R = R + S - 1
    
19.                 Else
    
20.                     R = R + 1
    
21.                     Sheet2.Cells(R, C) = A
    
22.                 End If
    
23.             Next
    
24.         ElseIf InStr(Ar(0), ",") = False Then
    
25.             If InStr(Ar(0), "~") Then
    
26.                     Ar1 = Split(Ar(0), "~")
    
27.                     R = R + 1
    
28.                     S = Ar1(1) - Right(Ar1(0), Len(Ar1(1))) + 1
    
29.                     Sheet2.Cells(R, C) = Ar1(0)
    
30.                     Sheet2.Cells(R, C).AutoFill Sheet2.Cells(R, C).Resize(S)
    
31.                     R = R + S - 1
    
32.                 Else
    
33.                     R = R + 1
    
34.                     Sheet2.Cells(R, C) = Ar(0)
    
35.                 End If
    
36.         
    
37.         End If
    
38.         C = C + 1
    
39.         R = 1
    
40.     Next
    
41. End Sub

½Æ»s¥N½X

sujane0701

¯u¬O¤Ó±j¤F!!!ÁÂÁ¦U¦ìª©¥D¤j¤j«ü¾É,¤p§Ì¸Õ¹L³£¥i¥H¸Ñ¨M°ÝÃD,¥t¥~Hsiehª©¥D¤j¤jªº¨ç¼Æ¦Û©w¸q,¤p§Ì§¹¥þºN¤£¨ìÃä,§V¤O»`¶°¸ê®Æ¾Ç²ß³o­Ó¦n¥Îªº§Þ¯à,¦A¦¸·PÁ¦U¦ì¤j¤j!!

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æ«e:

¤U¸ü (138.28 KB)

2023-5-17 10:18

°õ¦æµ²ªG:

¤U¸ü (166.33 KB)

2023-5-17 10:18

Option Explicit
Sub TEST()
Dim Brr, Crr, Q, R&, C&, i&, j&, N&, S$, T$, T1$, T2$, P$, K%, K1%, M&
Brr = Range([C1], Cells(Rows.Count, "A").End(3))
ReDim Crr(1 To 1000, 1 To UBound(Brr))
For i = 1 To UBound(Brr)
   T = Split(Brr(i, 3) & " ", " ")(0): R = 0
   R = R + 1: C = C + 1
   Crr(R, C) = Brr(i, 1) & "-" & Brr(i, 2)
   For Each Q In Split(T, ",")
      P = StrReverse(Q)
      K = InStr(P, "~") - 1
      S = StrReverse(Mid(Val(1 & Mid(P, K + 2)), 2))
      K1 = Len(S)
      If K > -1 Then
         T1 = Split(Q, "~")(0): T2 = Split(Q, "~")(1)
         N = Val(Right(T2, K)) - Val(Right(T1, K))
         For j = 0 To N
            R = R + 1: Crr(R, C) = Mid(StrReverse(T1), K1 + 1) & S + j
         Next
         Else
            R = R + 1: Crr(R, C) = Q
      End If
   Next
   If M < R Then M = R
Next
[H:K].ClearContents
[H1].Resize(M, C) = Crr
Erase Brr, Crr
End Sub