[µo°Ý] ¨Ì±ø¥ó½Æ»s¤£¦PÄæ¦ì¸ê®Æ»P´M§ä¨ú¥N

b9208

¥H¤Uµ{¦¡¥Ñ¿ý»s­×§ï¡A¸ê®Æ´X¤dµ§¡A°õ¦æ®É¶¡»Ý­n´X¤ÀÄÁ¡A½Ð±Ð¬O§_¦³ºë¶iµ{¦¡¥i¥HÁYµu°õ¦æ®É¶¡¡H
Sub main()
Application.ScreenUpdating = False
Set WS = Worksheets("¸ê®Æ")
Set WT = Worksheets("¿é¥X")
K = 5
With WS
WT.Cells(2, "A") = .Cells(2, "A")
    For i = 6 To .Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
        If .Cells(i, "AD") <> "" Then
            WT.Cells(K, "A") = .Cells(i, "B")
            WT.Cells(K, "B") = .Cells(i, "C")
            WT.Cells(K, "C") = .Cells(i, "D")
            WT.Cells(K, "D") = .Cells(i, "E")
            WT.Cells(K, "E") = .Cells(i, "F")
            WT.Cells(K, "F") = .Cells(i, "G")
            WT.Cells(K, "G") = .Cells(i, "H")
            WT.Cells(K, "H") = .Cells(i, "AB")
            WT.Cells(K, "I") = .Cells(i, "AC")
            WT.Cells(K, "J") = .Cells(i, "AD")
            WT.Cells(K, "K") = Left(.Cells(i, "AF"), 8)
            WT.Cells(K, "L") = Right(.Cells(i, "AF"), 5)
            WT.Cells(K, "M") = Left(.Cells(i, "AG"), 8)
            WT.Cells(K, "N") = Right(.Cells(i, "AG"), 5)
            
            WT.Range("A" & K & ":O" & K).Select
            Selection.Borders.LineStyle = xlContinuous
            K = K + 1
        End If
    Next i
.Range("a5:o" & [j1048576].End(xlUp).Row).Select
Selection.Sort key1:=.[B5], key2:=.[J5], Header:=xlNo
End With

With WT
.Range("a5:o" & [j1048576].End(xlUp).Row).Select
Selection.Sort key1:=.[B5], key2:=.[J5], Header:=xlNo
.Range("h5:I" & [j1048576].End(xlUp).Row).Select
Selection.Replace What:="*AA*", Replacement:="AAA"
Selection.Replace What:="*BBB*", Replacement:="BBB"
Selection.Replace What:="*CC*", Replacement:="CCC"
Selection.Replace What:="*DDD*", Replacement:="DDD"
Selection.Replace What:="*EEE*", Replacement:="DDD"
Selection.Replace What:="*FFF*", Replacement:="FFF"
Selection.Replace What:="*GGG*", Replacement:="GGG"
Selection.Replace What:="*HH*", Replacement:="GGG"
Selection.Replace What:="*MM*", Replacement:="MMM"
Selection.Replace What:="*LLL*", Replacement:="LLL"
Selection.Replace What:="*QQQ*", Replacement:="LLL"
Selection.Replace What:="*NNN*", Replacement:="NNN"
Selection.Replace What:="*TTT*", Replacement:="NNN"
End With
End Sub

b9208

¦^´_ 12# n7822123
­ã¤j¡BÀs¤j
«D±`·PÁ¤G¦ì¤j¤j«ü¾É

n7822123

¦^´_ 11# ­ã´£³¡ªL

°Ú~·PÁ·ǤjªÈ¿ù  

§Ú§â­ìµ{¦¡ ªº³o¦æ .Range("a5¡Go" & [j1048576].End(xlUp).Row).Select

¬Ý¦¨¬OA~JÄæ¤F   ¡AÀ³¸Ó¬OA~O¤~¹ï ¡A¬Ý¤Ó§Ö¬Ý¿ù¤F.....

­ìPOÁÙ¨Sµo²{¨ì..... µ{¦¡­×§ï¦p¤U(¦]¬°³£¬OA~O¡A»P¤W­±¦X¨Ö)

Sub main()
Application.ScreenUpdating = False
Worksheets("¿é¥X").Activate
Ci = Array(, 2, 3, 4, 5, 6, 7, 8, 18, 19, 20, 22, 22, 23, 23)
Set Rg = [¸ê®Æ!A1048576].End(xlUp)
If Rg.Row = 1 Then Exit Sub
[A4].CurrentRegion.Resize(, 15).Offset(1).Clear
Arr = Range([¸ê®Æ!W6], Rg)
Brr = [A5].Resize(UBound(Arr), 15)
[A2] = [¸ê®Æ!A2]
For R = 1 To UBound(Brr)
  If Arr(R, 20) <> "" Then
      Ro = Ro + 1
      For C = 1 To 14
            If C <= 10 Then Brr(Ro, C) = Arr(R, Ci(C))
            If C = 11 Or C = 13 Then Brr(Ro, C) = Left(Arr(R, Ci(C)), 8)
            If C = 12 Or C = 14 Then Brr(Ro, C) = Right(Arr(R, Ci(C)), 5)
      Next C
  End If
Next R
With [A5].Resize(Ro, 15)  'A~OÄæ¶ñ­È+¹º®Ø½u+±Æ§Ç
    .Value = Brr
    .Borders.LineStyle = xlContinuous
    .Sort key1:=.Item(2), key2:=.Item(10), Header:=xlNo
End With
With [H5].Resize(Ro, 2)   'H¡BIÄæ°µ¨ú¥N
    .Replace "*AA*", "AAA"
    .Replace "*BBB*", "BBB"
    .Replace "*CC*", "CCC"
    .Replace "*DDD*", "DDD"
    .Replace "*EEE*", "DDD"
    .Replace "*FFF*", "FFF"
    .Replace "*GGG*", "GGG"
    .Replace "*HH*", "GGG"
    .Replace "*MM*", "MMM"
    .Replace "*LLL*", "LLL"
    .Replace "*QQQ*", "LLL"
    .Replace "*NNN*", "NNN"
    .Replace "*TTT*", "NNN"
End With
End Sub

­ã´£³¡ªL

Sub TEST()
Dim Arr, TS, Cr, C%, i&, j%, N&
Sheets("¿é¥X").UsedRange.Offset(4, 0).EntireRow.Delete
Arr = Range([¸ê®Æ!A1], Sheets("¸ê®Æ").UsedRange)
Cr = Array(, 2, 3, 4, 5, 6, 7, 8, 18, 19, 20, 22, 22, 23, 23)
For i = 6 To UBound(Arr)
    If Arr(i, 20) <> "" Then N = N + 1 Else GoTo i01
    For j = 1 To UBound(Cr)
        Arr(N, j) = Arr(i, Cr(j))
        If j = 11 Or j = 13 Then Arr(N, j) = Left(Arr(N, j), 8)
        If j = 12 Or j = 14 Then Arr(N, j) = Right(Arr(N, j), 5)
    Next j
i01: Next i
If N = 0 Then Exit Sub
Application.ScreenUpdating = False
With [A5].Resize(N, UBound(Cr))
     .Value = Arr
     .Borders.LineStyle = 1
     .Sort key1:=.Item(2), key2:=.Item(10), Header:=xlNo
     With Range(.Columns(8), .Columns(9))
          For Each TS In Array("AA_A", "BBB_B", "CC_C", "DDD_D", "EEE_D", "FFF_F", "GGG_G", "HH_G", "MM_M", "LLL_L", "QQQ_L", "NNN_N", "TTT_N")
              Cr = Split(TS, "_")
              .Replace "*" & Cr(0) & "*", String(3, Cr(1))
          Next
     End With
End With
End Sub

¼gªk¤j­P¬Û¦P~~
±Æ§Ç¬°¦ó¥u¦³«e10Äæ, ¨º«á­±¤£´N¶Ã¤F®M???

b9208

¦^´_ 9# n7822123
«D±`·PÁ«ü¾É
°ÝÃD¸Ñ¨M¤F

n7822123

¦^´_ 8# b9208

¦ý¦³¤@­Ó°ÝÃD¡A¿é¥X¤¤®Ø½u¦C¼Æ»P¸ê®Æ¦C¼Æ¬Û¦P¡A¤]´N¬O¿é¥X¤¤¨S¦³¸ê®Æ¦C¼Æ¤]¹º®Ø½u¡C

¦]¬°¦³±ø¥ó¿z¿ï«á¡A¸ê®Æ¦C¼Æ»P¿é¥X¦C¼Æ·|Åܦ¨¤£¤@¼Ë¤F¡A³o­è­è§ïµ¹§A®É¨S¦Ò¼{¨ì

©Ò¥H§Ú·s¼W "Ro" ÅܼƨӬö¿ý¿z¿ï¹L«áªº¦C¼Æ

¥t¡B½Ð±Ð¦p©ó°õ¦æ«e¡A¥ý²M°£¿é¥X¼ÐÃD¦C¥H¤UÀx¦s®æ¤§¤º®e¡B®Ø½u¤Î¶ñº¡ÃC¦â¡A¤£¥Î.Delete¤èªk¡A¦³¨ä¥L¤èªk¥i¥H¹F¦¨¡H

¥ÎClear ¤èªk§Y¥i²M°£¡A§Ú·|§â­×§ïªº¦a¤è¥Î¬õ¦âªí¥Ü

µ{¦¡¦p¤U

Sub main()
Application.ScreenUpdating = False
Worksheets("¿é¥X").Activate
Ci = Array(, 2, 3, 4, 5, 6, 7, 8, 18, 19, 20, 22, 22, 23, 23)
Set Rg = [¸ê®Æ!A1048576].End(xlUp)
If Rg.Row = 1 Then Exit Sub
[A4].CurrentRegion.Resize(, 15).Offset(1).Clear
Arr = Range([¸ê®Æ!W6], Rg)
Brr = [A5].Resize(UBound(Arr), 15)
[A2] = [¸ê®Æ!A2]
For R = 1 To UBound(Brr)
  If Arr(R, 20) <> "" Then
      Ro = Ro + 1
      For C = 1 To 14
            If C <= 10 Then Brr(Ro, C) = Arr(R, Ci(C))
            If C = 11 Or C = 13 Then Brr(Ro, C) = Left(Arr(R, Ci(C)), 8)
            If C = 12 Or C = 14 Then Brr(Ro, C) = Right(Arr(R, Ci(C)), 5)
      Next C
  End If
Next R
With [A5].Resize(Ro, 15)  'A~OÄæ¶ñ­È+¹º®Ø½u
    .Value = Brr
    .Borders.LineStyle = xlContinuous
End With
With [A5].Resize(Ro, 14)   'A~JÄæ°µ±Æ§Ç
    .Sort key1:=.Item(2), key2:=.Item(10), Header:=xlNo
End With
With [H5].Resize(Ro, 2)   'H¡BIÄæ°µ¨ú¥N
    .Replace "*AA*", "AAA"
    .Replace "*BBB*", "BBB"
    .Replace "*CC*", "CCC"
    .Replace "*DDD*", "DDD"
    .Replace "*EEE*", "DDD"
    .Replace "*FFF*", "FFF"
    .Replace "*GGG*", "GGG"
    .Replace "*HH*", "GGG"
    .Replace "*MM*", "MMM"
    .Replace "*LLL*", "LLL"
    .Replace "*QQQ*", "LLL"
    .Replace "*NNN*", "NNN"
    .Replace "*TTT*", "NNN"
End With
End Sub

Àɮצp¤U

q2+2.rar (20.96 KB)

¤U¸ü¦¸¼Æ: 11

2020-8-22 23:01

b9208

¦^´_ 7# n7822123
«D±`·PÁ¡A°õ¦æOK¡C
¦ý¦³¤@­Ó°ÝÃD¡A¿é¥X¤¤®Ø½u¦C¼Æ»P¸ê®Æ¦C¼Æ¬Û¦P¡A¤]´N¬O¿é¥X¤¤¨S¦³¸ê®Æ¦C¼Æ¤]¹º®Ø½u¡C
¥t¡B½Ð±Ð¦p©ó°õ¦æ«e¡A¥ý²M°£¿é¥X¼ÐÃD¦C¥H¤UÀx¦s®æ¤§¤º®e¡B®Ø½u¤Î¶ñº¡ÃC¦â¡A¤£¥Î.Delete¤èªk¡A¦³¨ä¥L¤èªk¥i¥H¹F¦¨¡H q2.rar (21.7 KB)

¤U¸ü¦¸¼Æ: 8

2020-8-22 21:37

n7822123

¦^´_ 6# b9208

½Ð°Ý¦p¨Ì¹ê»ÚÀÉ®×A~AZÄæ¦ì¡A¨Ì¾Ú¡§AD¡¨Äæ¦ì¦³¸ê®Æ¡A«hcopyÄæ¦ì¦p¤U¡G
Ci = Array(, 2, 3, 4, 5, 6, 7, 8, 28, 29, 30, 32, 32, 33, 33)
½Ð°Ý¦p¦ó­×­q

33Äæ¨ìAG¥h¤F¡A¨Ó·½°}¦CArr­n¨ú¸ê®Æ¨ìAGÄæ

¨Ã¥Î²Ä30Äæ(AD)§PÂ_

¦pªG¥u§ï¨Ó·½¸ê®Æªº¦ì¸m¡A¿é¥XªºÄæ¦ì³£¤@¼Ë

­×§ïµ{¦¡¦p¤U (¶ÈºI¤@¤p¬q»¡©ú)

Sub main()
Application.ScreenUpdating = False
Worksheets("¿é¥X").Activate
Ci = Array(, 2, 3, 4, 5, 6, 7, 8, 28, 29, 30, 32, 32, 33, 33)
Set Rg = [¸ê®Æ!A1048576].End(xlUp)
If Rg.Row = 1 Then Exit Sub
Arr = Range([¸ê®Æ!AG6], Rg)
Brr = [A5].Resize(UBound(Arr), 15)
[A2] = [¸ê®Æ!A2]
For R = 1 To UBound(Brr): For C = 1 To 14
   If Arr(R, 30) <> "" Then
        If C <= 10 Then Brr(R, C) = Arr(R, Ci(C))
        If C = 11 Or C = 13 Then Brr(R, C) = Left(Arr(R, Ci(C)), 8)
        If C = 12 Or C = 14 Then Brr(R, C) = Right(Arr(R, Ci(C)), 5)
    End If
Next C: Next R
...
...
...

b9208

¦^´_ 5# n7822123
«D±`©êºp¡A¨S¦³­×­q¨ì¡C
­ìÀɮצ@¦³52Äæ(AZ)¡A¨Ì¾ÚADÄ榳¸ê®Æ¡A«hcopy»Ý­nÄæ¦ì¸ê®Æ¡C
.cells(i, "AD") <> "" Then À³­×§ï¬° .cells(i, "T") <> "" Then
½Ð°Ý¦p¨Ì¹ê»ÚÀÉ®×A~AZÄæ¦ì¡A¨Ì¾Ú¡§AD¡¨Äæ¦ì¦³¸ê®Æ¡A«hcopyÄæ¦ì¦p¤U¡G
Ci = Array(, 2, 3, 4, 5, 6, 7, 8, 28, 29, 30, 32, 32, 33, 33)
½Ð°Ý¦p¦ó­×­q

n7822123

¦^´_ 4# b9208


¬O°Ñ¦Ò§Aªº­ìµ{¦¡³¡¤À¡A¤U¹Ï

§Ú»{¬°§A¬O§â²¤Æ¹Lªº¸ê®Æ¥á¤W¨Ó¡A¹ê»ÚÁٻݭn¦h§PÂ_AD¨º¤@Ä檺­È

©Ò¥H§Ú¸ê®Æ¨úªº½d³ò¤j¤@ÂI~~ÁקK§A­n§ï¡A¨Sªk§PÂ_

²{¦b¬Ý¨Ó¬O¤@­Ó ¬üÄRªº»~·| ?

¤U¸ü (16.51 KB)

2020-8-22 16:51