[µ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

¦^´_ 1# b9208
«D±`©êºp
¥Ñ©ó²£¥Í¶Ã½X¡A©Ò¥H­«·s¥HÀɮפW¶Ç¡C
µ{§Ç¥Ñ¿ý»s­×§ï¡A¸ê®Æ´X¤dµ§¡A°õ¦æ®É¶¡»Ý­n´X¤ÀÄÁ¡A½Ð±Ð¬O§_¦³ºë¶iµ{®i¦¡¥i¥HÁYµu°õ¦æ®É¶¡¡H
µ{¦¡½X½Ð¬ÝªþÀɼҲÕ
q1.rar (21.01 KB)

¤U¸ü¦¸¼Æ: 12

2020-8-22 10:48

n7822123

¦^´_ 2# b9208

¥ÎCellÀx¦s®æ¤@­Ó¤@­Ó¶Ç­È·|«ÜºC

¦]¬°Cell¬O­Óª«¥ó¡A¦û¤£¤ÖÀx¦s¦ì¤¸ªÅ¶¡¡A¸Ì­±¥]§t¤FÄæ¼e¡B¦C°ª¡BÃC¦â¡B®æ¦¡¡B¦ì¸m.....¤@³s¦êªº¸ê®Æ

©Ò¥H¥ý§âÀx¦s®æªº"­È"¥áµ¹°O¾ÐÅé(°}¦C)¡AµM«á°µ³B²z

³B²z§¹¦A¤@¦¸¥á¦^µ¹Àx¦s®æ¡A³o¤è¦¡®Ä²v¤ñ¸û°ª (°O¾ÐÅé³B²z¦ì¤¸³t«×¤]·|¤ñÂà½L¦¡ºÏºÐ§Ö)

²Ä2¬qµ{¦¡¤w¸g¬O°ª®Äªº¼gªk¡A§Ú¬O·Q¤£¨ì¦p¦ó¥iÀu¤Æ®Ä²v¤F¡A¥uÀ°§A²¤Æµ{¦¡½X

µM«á§Aµ¹ªº¸ê®Æ­¶¡AAÄæ¨SªF¦è¡A©Ò¥H«e¥b¬q¨Sªk°õ¦æ¨ì~ §Ú¦Û¤v²K¥[¬y¤ô¸¹´ú¸Õ

µ{¦¡¦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
Arr = Range([¸ê®Æ!AD6], Rg)
Brr = [A5].Resize(UBound(Arr), 15)
[A2] = [¸ê®Æ!A2]
For R = 1 To UBound(Brr): For C = 1 To 14
    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)
Next C: Next R
With [A5].Resize(UBound(Brr), 15)  'A~OÄæ¶ñ­È+¹º®Ø½u
    .Value = Brr
    .Borders.LineStyle = xlContinuous
End With
With [A5].Resize(UBound(Brr), 10)   'A~JÄæ°µ±Æ§Ç
    .Sort key1:=.Item(2), key2:=.Item(10), Header:=xlNo
End With
With [H5].Resize(UBound(Brr), 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

q1+.rar (21.58 KB)

¤U¸ü¦¸¼Æ: 14

2020-8-22 13:45

b9208

¦^´_ 3# n7822123
½Ð°Ý¤U­z¥y¤l Arr = Range([¸ê®Æ¡IAD6], Rg) ¤¤¡ªAD6¡ª¬O«ü¤°»ò¡H¸ê®Æ¤u§@ªíAD6¬OªÅ¥Õ¡C·PÁ«ü¾É¡C
Set Rg = [¸ê®Æ!A1048576].End(xlUp)
If Rg.Row = 1 Then Exit Sub
Arr = Range([¸ê®Æ!AD6], Rg)
Brr = [A5].Resize(UBound(Arr), 15)

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

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

¦^´_ 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

¦^´_ 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

¦^´_ 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¸ü¦¸¼Æ: 10

2020-8-22 23:01

b9208

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