[µo°Ý] §Ç¸¹(Äx¸¹)¦p¦óºI¨ú¬YÀx¦s®æ¤¤«á2¼Æ

BV7BW

¦p¦ó±N§Ç¸¹(Äx¸¹)B2§ï¬°ºI¨úC2³Ì«á2¼Æ¬°§Ç¸¹(Äx¸¹)
±NÄx¸¹(§Ç¸¹)(BÄæ)§ó§ï¥H½s¸¹(CÄæ)«á2¦ì¼Æ
¦p«á­±¦³S«h¥HS«e2¦ì¼Æ

Sub ¬£¨®ªí_¿é¤J()
Dim DD, CC$, Arr, Brr, i&, j%, N&, xD
Call ¬£¨®ªí_²M°£
DD = [D1]: CC = [B1]
If Not IsDate(DD) Then MsgBox "**½Ð¿é¤J¤é´Á!!  ": Exit Sub
If CC = "" Then MsgBox "**½Ð¿é¤J[¨®½s]!!  ": Exit Sub
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([¤u§@ªí2!L1], [¤u§@ªí2!A65536].End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 4)
For i = 2 To UBound(Arr)
    If Arr(i, 12) <> DD Or Arr(i, 10) <> CC Then GoTo 101
    PNo = Arr(i, 11): If xD(PNo) = 1 Then GoTo 101
    xD(PNo) = 1:  N = N + 1: Arr(N, 2) = Format(N, "00")     '¦³¸ê®Æ®ÉArrªº²Ä2Äæ¦ì¡A¦Û°Ê²£¥Í§Ç¸¹
    For j = 1 To 4
        Brr(N, 1) = Arr(i, 1)
        Brr(N, 3) = Arr(i, 2)
        Brr(N, 2) = Arr(N, 2)
    Next j
    Brr(N, 4) = Arr(i, 11)
101: Next i
If N = 0 Then MsgBox "**¨S¦³²Å¦Xªº¸ê®Æ!!  ": Exit Sub
With Sheets("¤u§@ªí1")
     .[A3].Resize(N, UBound(Brr, 2)) = Brr
     .Range("A1:G" & N + 3).Name = "'" & .Name & "'!Print_Area"
     .Range("1:3").Name = "'" & .Name & "'!Print_Titles"
End With
End Sub
¬£¨®ªí§Ç¸¹­×­q.zip (43.86 KB)

¤U¸ü¦¸¼Æ: 14

2021-6-4 11:27

samwang

¦^´_ 1# BV7BW

½Ð´ú¸Õ¬Ý¬Ý¡A¤£ª¾¬O§_¬°±zªº»Ý¨D¡AÁÂÁ¡C

Sub ¬£¨®ªí_¿é¤J1()
Dim DD, CC$, Arr, Brr, i&, j%, N&, xD
Call ¬£¨®ªí_²M°£
DD = [D1]: CC = [B1]
If Not IsDate(DD) Then MsgBox "**½Ð¿é¤J¤é´Á!!  ": Exit Sub
If CC = "" Then MsgBox "**½Ð¿é¤J[¨®½s]!!  ": Exit Sub
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([¤u§@ªí2!L1], [¤u§@ªí2!A65536].End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 4)
For i = 2 To UBound(Arr)
    If Arr(i, 12) <> DD Or Arr(i, 10) <> CC Then GoTo 101
    PNo = Arr(i, 11): If xD(PNo) = 1 Then GoTo 101
    xD(PNo) = 1:  N = N + 1
   If InStr(Arr(i, 2), "A") Then
        Brr(N, 2) = Format(Right(Arr(i, 2), 2), "00")
    Else
        Brr(N, 2) = Format(Mid(Right(Arr(i, 2), 3), 1, 2), "00")
    End If
    Brr(N, 1) = Arr(i, 1)
    Brr(N, 3) = Arr(i, 2)
    Brr(N, 4) = Arr(i, 11)
101: Next i
If N = 0 Then MsgBox "**¨S¦³²Å¦Xªº¸ê®Æ!!  ": Exit Sub
With Sheets("¤u§@ªí1")
     .[A3].Resize(N, UBound(Brr, 2)) = Brr
     .Range("A1:G" & N + 3).Name = "'" & .Name & "'!Print_Area"
     .Range("1:3").Name = "'" & .Name & "'!Print_Titles"
End With
End Sub

BV7BW

[b   ´_ 2# samwang
ÁÂÁÂ S¤j¤j
§Ú¥ý´ú¸Õ¹B¥Î¦b¦V§A³ø§i
ÁÂÁÂ

hcm19522

°Ñ¦Ò   
https://blog.xuite.net/hcm19522/twblog/589814048

BV7BW

¦^´_ 4# hcm19522
ÁÂÁÂ hcm ¥ý¶i«e½ú
³ö¨Ñ¸ê°T.¹ê¥Î¥i´` ÁÂÁÂ

BV7BW

¦^´_ 2# samwang
  S¤j¤j§A¦n
¸g´ú¸Õ«á¦³­Ó°ÝÃD½Ð°Ý
­ì¥»¬O¥HIf InStr(Arr(i, 2), "A") Then ¤Î Brr(N, 2) = Format(Right(Arr(i, 2), 2), "00")
    §ï¥HIf InStr(Arr(i, 2), "Äx") Then ¤Î Brr(N, 2) = Format(Right(Arr(i, 2), 4), "00")«á
    ¥i¥X²{"ÄxA11".¥i¥H¹B¥Î
¦ý¤£ª¾§ï Brr(N, 2) = Format(Mid(Right(Arr(i, 2), 3), 1, 2), "00")¤§­þ¸Ì
    ¤~¥i¥X²{ÄxAS00
      ¬£¨®ªí§Ç¸¹­×­q.zip (42.33 KB)

¤U¸ü¦¸¼Æ: 4

2021-6-8 09:21

½Ð¥Ü«ü±Ð ÁÂÁÂ

n7822123

¦^´_ 1# BV7BW



³o¤@¦ê¦³ÂI²V¶Ã¡A§ÚÁÙ¬O¥H1¼Ó»Ý¨D¨Ó¬Ý´N¦n¡A­×§ï"¬£¨®ªí_¿é¤J"³o­Óµ{§Ç

¦p¦ó±N§Ç¸¹(Äx¸¹)B2§ï¬°ºI¨úC2³Ì«á2¼Æ¬°§Ç¸¹(Äx¸¹)
±NÄx¸¹(§Ç¸¹)(BÄæ)§ó§ï¥H½s¸¹(CÄæ)«á2¦ì¼Æ
¦p«á­±¦³S«h¥HS«e2¦ì¼Æ

¤£¤@¼Ëªº¦a¤è§Ú¤]¥Î¬õ¦â¼Ðª`

Sub ¬£¨®ªí_¿é¤J()
Dim DD, CC$, Arr, Brr, i&, j%, N&, xD
Call ¬£¨®ªí_²M°£
DD = [D1]: CC = [B1]
If Not IsDate(DD) Then MsgBox "**½Ð¿é¤J¤é´Á!!  ": Exit Sub
If CC = "" Then MsgBox "**½Ð¿é¤J[¨®½s]!!  ": Exit Sub
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([¤u§@ªí2!L1], [¤u§@ªí2!A65536].End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 4)
For i = 2 To UBound(Arr)
    If Arr(i, 12) <> DD Or Arr(i, 10) <> CC Then GoTo 101
    PNo = Arr(i, 11): If xD(PNo) = 1 Then GoTo 101
    xD(PNo) = 1
    N = N + 1
    For j = 1 To 4
        Brr(N, 1) = Arr(i, 1)
        SS$ = Replace(Arr(i, 2), "S", "")
        Brr(N, 2) = Right(SS, 2)
        Brr(N, 3) = Arr(i, 2)
    Next j
    Brr(N, 4) = Arr(i, 11)
101: Next i
If N = 0 Then MsgBox "**¨S¦³²Å¦Xªº¸ê®Æ!!  ": Exit Sub
With Sheets("¤u§@ªí1")
     .[A3].Resize(N, UBound(Brr, 2)) = Brr
     .Range("A1:G" & N + 3).Name = "'" & .Name & "'!Print_Area"
     .Range("1:3").Name = "'" & .Name & "'!Print_Titles"
End With
Columns("B").NumberFormatLocal = "00"
End Sub

samwang

¦^´_ 6# BV7BW

½Ð¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub ¬£¨®ªí_¿é¤J2()
Dim DD, CC$, Arr, Brr, i&, j%, N&, xD
Call ¬£¨®ªí_²M°£
DD = [D1]: CC = [B1]
If Not IsDate(DD) Then MsgBox "**½Ð¿é¤J¤é´Á!!  ": Exit Sub
If CC = "" Then MsgBox "**½Ð¿é¤J[¨®½s]!!  ": Exit Sub
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([¤u§@ªí2!L1], [¤u§@ªí2!A65536].End(xlUp))
ReDim Brr(1 To UBound(Arr), 1 To 4)
For i = 2 To UBound(Arr)
    If Arr(i, 12) <> DD Or Arr(i, 10) <> CC Then GoTo 101
    PNo = Arr(i, 11): If xD(PNo) = 1 Then GoTo 101
    xD(PNo) = 1:  N = N + 1
   If InStr(Arr(i, 2), "S") Then
        Brr(N, 2) = Mid(Split(Arr(i, 2), "-")(1), 1, Len(Split(Arr(i, 2), "-")(1)) - 1)
    Else
        Brr(N, 2) = Split(Arr(i, 2), "-")(1)
    End If
    Brr(N, 1) = Arr(i, 1)
    Brr(N, 3) = Arr(i, 2)
    Brr(N, 4) = Arr(i, 11)
101: Next i
If N = 0 Then MsgBox "**¨S¦³²Å¦Xªº¸ê®Æ!!  ": Exit Sub
With Sheets("¤u§@ªí1")
     .[A3].Resize(N, UBound(Brr, 2)) = Brr
     .Range("A1:G" & N + 3).Name = "'" & .Name & "'!Print_Area"
     .Range("1:3").Name = "'" & .Name & "'!Print_Titles"
End With
End Sub

BV7BW

¦^´_ 8# samwang
ÁÂÁÂS¤j¤j
§¹¥þ¥¿½T¹B¥Î
·PÁ«ü¾É ÁÂÁÂ