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

[µo°Ý] ¦p¦ó«ö¶s¦X¨Ö»P¼W¥[µ{¦¡

[µo°Ý] ¦p¦ó«ö¶s¦X¨Ö»P¼W¥[µ{¦¡

½Ð±Ð ¦U¦ì ¥ý¶i «e½ú ¦Ñ®v­Ì

¦p¦ó«ö¶s¦X¨Ö»P¼W¥[µ{¦¡

°ÝÃD1)"ºî¦X¿é¤J"»P"³æ¨®¿é¤J"¬O§_¥i¦X¨Ö¦¨1³æ¿W«ö¶s
¥H"±ÄÁʻݨDªí""A1"¬°§P§O¸ê®Æ
¦p:A¨®"´N»Ý¥Î"³æ¨®À¹¤J"«ö¯Ã°õ¦æ
¦p¦ó¿ì§O"A1"¬°"ºî¦X"®É´N»Ý¥H"ºî¦XÀ¹¤J"«ö¶s°õ¦æ

°ÝÃD2)À¹¤J¸ê®Æ«e¥ý²M°£®Ø½u.À¹¤J«á¥H"A1"¦Ü³Ì«á1µ§¸ê®Æ¹º¤W®Ø½u

°ÝÃD3)"±ÄÁʻݨDªí""A1"¬O§_¥i½Æ»s¦Ü"«È¤á°t°eªí"A1"¤¤¼W¦C¶i¥h
²{¥H=IF(±ÄÁʻݨDªí!A1="","",±ÄÁʻݨDªí!A1)  ¨Ï¥Î
¬O§_¥i¤@¨Ö¦bµ{¦¡¤¤

»Ý¨D1)¦p¦ó¿ì§O"A1"¬°"ºî¦X"®É´N»Ý¥H"ºî¦XÀ¹¤J"«ö¶s°õ¦æ
»Ý¨D2)À¹¤J¸ê®Æ«e¥ý²M°£®Ø½u.À¹¤J«á¥H"A1"¦Ü³Ì«á1µ§¸ê®Æ¹º¤W®Ø½u
»Ý¨D3)­ìµ{¦¡¤¤¼W¦C"±ÄÁʻݨDªí""A1"½Æ»s¦Ü"«È¤á°t°eªí"A1"¤¤
   ÁÂÁ¦U¦ì ¥ý¶i «e½ú ¦Ñ®v­Ì «ü¾É
¬¡­¶Ã¯1.zip (66.09 KB)
±Ó¦Ó¦n¾Ç,¤£®¢¤U°Ý

¦^´_ 1# BV7BW

¬¡­¶Ã¯1.zip (63.64 KB)

TOP

¦^´_ 2# singo1232001

·PÁ singo1232001 ¤j¤j «ü¾É

°ÝÃD1.3)¥Hsingo1232001 ¤j¤j¨Á­×§ï«á¦X­Á»Ý¨D

°ÝÃD2)¤]­×§ï¤@¥b§¹¦¨.
¥t¤@¥b¬O¥Ñµ{¦¡§PÂ_³Ì«á¤@µ§¸ê®Æ«á¹º¤W®Ø½u

Sub ºî¦X_¸ü¤J_¥ý¾Éµ{§Ç()
'µ{¦¡¸ê®Æ¨Ó·½¦Üsingo1232001-110-08-08ª©
[«È¤á°t°eªí!a1] = [±ÄÁʻݨDªí!a1] '·s¼W
Call ²M°£®Ø½u  '·s¼W
If [±ÄÁʻݨDªí!a1] = "ºî¦X" Then Call ±ÄÁʻݨD«È¤á°t°e_ºî¦X
If [±ÄÁʻݨDªí!a1] <> "ºî¦X" Then Call ±ÄÁʻݨD«È¤á°t°e_¸ü¤J
End Sub
Sub ²M°£®Ø½u() '¿ý»s¥¨¶°ªº
    Set Rng = [±ÄÁʻݨDªí!a2:c100]
    Rng.Borders(xlDiagonalDown).LineStyle = xlNone
    Rng.Borders(xlDiagonalUp).LineStyle = xlNone
    Rng.Borders(xlEdgeLeft).LineStyle = xlNone
    With Rng.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Rng.Borders(xlEdgeBottom).LineStyle = xlNone
    Rng.Borders(xlEdgeRight).LineStyle = xlNone
    Rng.Borders(xlInsideVertical).LineStyle = xlNone
    Rng.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub



Sub ±ÄÁʻݨD«È¤á°t°e_¸ü¤J()

'[«È¤á°t°eªí!a1] = [±ÄÁʻݨDªí!a1] ''''''''''''''''''''''''''''
'µ{¦¡¸ê®Æ¨Ó·½¦Ü­ã´£³¡ªL_¥X³f§@·~Dª©V01_10905
Dim Arr, Brr, Crr, xD, N&, i&, T$, U&, DD, CC$
[±ÄÁʻݨDªí!A2:C500].ClearContents
[«È¤á°t°eªí!A2:C500].ClearContents

DD = [C1]: CC = [A1]
If Not IsDate(DD) Then MsgBox "**½Ð¿é¤J¤é´Á!!  ": Exit Sub
If CC = "" Then MsgBox "**½Ð¿é¤J[¨®½s]!!  ": Exit Sub
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([­q³f©ú²Óªí!L1], [­q³f©ú²Óªí!A65536].End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 3): Crr = Brr
For i = 2 To UBound(Arr)
    If Arr(i, 12) <> DD Or Arr(i, 10) <> CC Then GoTo 101 '¤ñ¹ï¤é´Á&¨®½s
    T = Arr(i, 3):  U = xD(T)
    If U = 0 Then N = N + 1: U = N: xD(T) = N
    Brr(U, 1) = Arr(i, 9) 'Ãþ§O
    'Brr(U, 2) = "'" & Arr(i, 11) '¶µ¥Ø½s¸¹
    Brr(U, 2) = Arr(i, 4) '¶µ¥Ø¦WºÙ
    Brr(U, 3) = Brr(U, 3) & IIf(Brr(U, 3) = "", "", " + ") & Arr(i, 5) & "*" & Arr(i, 6)
    '---------------------------------
    Crr(U, 1) = Arr(i, 9) 'Ãþ§O
    'Crr(U, 2) = "'" & Arr(i, 11) '¶µ¥Ø½s¸¹
    Crr(U, 2) = Arr(i, 4) '¶µ¥Ø¦WºÙ
    Crr(U, 3) = Crr(U, 3) & IIf(Crr(U, 3) = "", "", " + ") & Arr(i, 2) & "*" & Arr(i, 5) & Arr(i, 6)  '¥[«È¤á½s
101: Next i
If N = 0 Then MsgBox "**¨S¦³²Å¦X«ü©w¤é´Á¸ê®Æ!!  ": Exit Sub
Application.ScreenUpdating = False

With [«È¤á°t°eªí!A2].Resize(N, 3)
     .Parent.[C1] = DD
     .Value = Crr
     .Sort Key1:=.Item(1), Order1:=xlAscending, _
           Key2:=.Item(2), Order2:=xlAscending, Header:=xlNo
    For i = N + 1 To 2 Step -1
         If .Cells(i, 1) <> .Cells(i - 1, 1) Then
            .Cells(i, 1).Resize(1, 3).Insert Shift:=xlDown
         End If
     Next i
End With
With [±ÄÁʻݨDªí!A2].Resize(N, 3)
     .Parent.[C1] = DD
     .Value = Brr
     .Sort Key1:=.Item(1), Order1:=xlAscending, _
           Key2:=.Item(2), Order2:=xlAscending, Header:=xlNo
     For i = N + 1 To 2 Step -1
         If .Cells(i, 1) <> .Cells(i - 1, 1) Then
            .Cells(i, 1).Resize(1, 3).Insert Shift:=xlDown
         End If
     Next i
End With
End Sub

Sub ±ÄÁʻݨD«È¤á°t°e_ºî¦X()
'µ{¦¡¸ê®Æ¨Ó·½¦Ü­ã´£³¡ªL_¥X³f§@·~Dª©V01_10905
Dim Arr, Brr, Crr, xD, N&, i&, T$, U&, DD
[±ÄÁʻݨDªí!A2:C500].ClearContents
[«È¤á°t°eªí!A2:C500].ClearContents
DD = [C1]
If Not IsDate(DD) Then MsgBox "**½Ð¿é¤J¤é´Á!!  ": Exit Sub
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([­q³f©ú²Óªí!L1], [­q³f©ú²Óªí!A65536].End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 3): Crr = Brr
For i = 2 To UBound(Arr)
    If Arr(i, 12) <> DD Then GoTo 101 '¤ñ¹ï¤é´Á
    T = Arr(i, 3):  U = xD(T)
    If U = 0 Then N = N + 1: U = N: xD(T) = N
    Brr(U, 1) = Arr(i, 9) 'Ãþ§O
    'Brr(U, 2) = "'" & Arr(i, 11) '¶µ¥Ø½s¸¹
    Brr(U, 2) = Arr(i, 4) '¶µ¥Ø¦WºÙ
    Brr(U, 3) = Brr(U, 3) & IIf(Brr(U, 3) = "", "", " + ") & Arr(i, 5) & "*" & Arr(i, 6)
    '---------------------------------
    Crr(U, 1) = Arr(i, 9) 'Ãþ§O
    'Crr(U, 2) = "'" & Arr(i, 11) '¶µ¥Ø½s¸¹
    Crr(U, 2) = Arr(i, 4) '¶µ¥Ø¦WºÙ
    Crr(U, 3) = Crr(U, 3) & IIf(Crr(U, 3) = "", "", " + ") & Arr(i, 2) & "*" & Arr(i, 5) & Arr(i, 6)  '¥[«È¤á½s
101: Next i
If N = 0 Then MsgBox "**¨S¦³²Å¦X«ü©w¤é´Á¸ê®Æ!!  ": Exit Sub
Application.ScreenUpdating = False

With [«È¤á°t°eªí!A2].Resize(N, 3)
     .Parent.[C1] = DD
     .Value = Crr
     .Sort Key1:=.Item(1), Order1:=xlAscending, _
           Key2:=.Item(2), Order2:=xlAscending, Header:=xlNo
    For i = N + 1 To 2 Step -1
         If .Cells(i, 1) <> .Cells(i - 1, 1) Then
            .Cells(i, 1).Resize(1, 3).Insert Shift:=xlDown
         End If
     Next i
End With
With [±ÄÁʻݨDªí!A2].Resize(N, 3)
     .Parent.[C1] = DD
     .Value = Brr
     .Sort Key1:=.Item(1), Order1:=xlAscending, _
           Key2:=.Item(2), Order2:=xlAscending, Header:=xlNo
     For i = N + 1 To 2 Step -1
         If .Cells(i, 1) <> .Cells(i - 1, 1) Then
            .Cells(i, 1).Resize(1, 3).Insert Shift:=xlDown
         End If
     Next i
End With
End Sub

ÁÂÁÂ singo1232001 ¤j¤j
±Ó¦Ó¦n¾Ç,¤£®¢¤U°Ý

TOP

¬¡­¶Ã¯1singo1232001ª©.zip (65.8 KB) ¦^´_ 3# BV7BW
±Ó¦Ó¦n¾Ç,¤£®¢¤U°Ý

TOP

¦^´_ 4# BV7BW
§ó¥¿ÀÉ®×. ¬¡­¶Ã¯1singo1232001ª©.zip (65.95 KB)
±Ó¦Ó¦n¾Ç,¤£®¢¤U°Ý

TOP

        ÀR«ä¦Û¦b : ºÉ¦h¤Ö¥»¥÷¡A´N±o¦h¤Ö¥»¨Æ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD