ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

¨D§U~©î¸ÑCellÄæ¦ì

¨D§U~©î¸ÑCellÄæ¦ì


¦U¦ì°ª¤â~¤p§Ì¦³­ÓÀÉ®×ID ³¡¤À¤º®e¦³¦h­ÓID(­Ó¼Æ¤£¤@)¤À¹j²Å¸¹¤À§O¬°; ¥H¤Î/
¤£ª¾¬O§_¦³¿ìªk¥i¥H³z¹Lµ{¦¡±Nªí³æID Âà´«¦¨³æ¤@¦æ

·PÁ°ª¤â¬Û§U~

¦^´_ 1# tommy.lin

¸Õ¬Ý¬Ý¡C
ÀɮפU¸ü¡Ghttp://ge.tt/2cokpIg1/v/0?c
[b]Kubi[/b]

TOP

¦n¹³»Ý­n¥Ó½Ð±b¸¹¤~¥i¥H¤U¸ü¬O?

TOP

¦^´_ 3# tommy.lin


©î¸Ñ¨Ó·½¬°A¡BBÄæ¡A
©î¸Ñ«á¼g¤JC¡BDÄæ¡C
Option Base 1
Sub test()
    Dim arr1, arr2
    Dim brr()
    er = [A65536].End(3).Row
    arr1 = Range("A2:B" & er)
    ActiveSheet.Columns(2).Replace "/", ";"
    arr2 = Range("A2:B" & er)
    For i = 1 To UBound(arr2)
        For j = 0 To UBound(Split(arr2(i, 2), ";"))
            n = n + 1
            ReDim Preserve brr(2, n)
            If j = 0 Then brr(1, n) = arr2(i, 1)
            brr(2, n) = Split(arr2(i, 2), ";")(j)
        Next j
    Next i
    [C2:D65536].ClearContents
    [C2].Resize(UBound(brr, 2), 2) = Application.Transpose(brr)
    Range("A2:B" & er) = arr1
    arr1 = ""
    arr2 = ""
    Erase brr
End Sub
[b]Kubi[/b]

TOP

¥i¥H¤F~~ ·PÁ³á~~
«ç»ò¼Ë½m²ß¥i¥HÅܳo»ò±j?
ÁÙ¬O¦³¦a¤è¥i¥H¤W½Ò?

TOP

Hi Kubi:
¤S¦pªG§Úªº¸ê®Æ©î¸Ñ¨Ó·½¬OA & D Äæ¦ì§Ú­n¦p¦ó­×§ïVB Åܦ¨§Ú·Q­nªº?

Regards
Tommy

TOP

¦^´_ 6# tommy.lin


¸ê®Æ©î¸Ñ¨Ó·½¬OA & D Äæ....
¥i§_½Ðª©¤jªþ¤W¦p#1ªº¹Ï§Î¡A¥H¤è«K¤F¸Ñ©Ò»Ý¡C
[b]Kubi[/b]

TOP


Hi Kubi:
¤£¦n·N«ä~ªì¾ÇªÌ°ÝÃD¤Ó¦h@@"§Æ±æ¨S³y¦¨§A§xÂZ

Regards
Tommy

TOP

¦^´_ 8# tommy.lin


ÀɮפU¸ü¡Ghttp://ge.tt/5PcoXKg1/v/0?c

©î¸Ñ¨Ó·½¬°A¡ãDÄæ¡A
©î¸Ñ«á¼g¤JE¡ãIÄæ¡C
Option Base 1
Sub test1()
    Dim arr1, arr2
    Dim brr()
    er = [A65536].End(3).Row
    arr1 = Range("A2:D" & er)
    ActiveSheet.Columns(4).Replace "/", ";"
    arr2 = Range("A2:D" & er)
    For i = 1 To UBound(arr2)
        For j = 0 To UBound(Split(arr2(i, 4), ";"))
            n = n + 1
            ReDim Preserve brr(5, n)
            If j = 0 Then
                brr(1, n) = arr2(i, 1)
                brr(2, n) = arr2(i, 2)
                brr(3, n) = arr2(i, 3)
                brr(4, n) = arr2(i, 1)
            End If
            brr(5, n) = Split(arr2(i, 4), ";")(j)
        Next j
    Next i
    [E2:I65536].ClearContents
    [E2].Resize(UBound(brr, 2), 5) = Application.Transpose(brr)
    Range("A2:D" & er) = arr1
    arr1 = ""
    arr2 = ""
    Erase brr
End Sub
[b]Kubi[/b]

TOP

Hi Kubi:
´ú¸Õ¥i¥H¨Ï¥Î
·PÁ§AªºÀ°¦£..¦³ªÅ°²¤é¥i¥H­Ó§O±Ð¾Ç?@@"

Regards

TOP

        ÀR«ä¦Û¦b : §g¤l¥ß«í§Ó¡A¤p¤H«í¥ß§Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD