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

[µo°Ý] ½Ð°Ý¦p¦ó§âµL¸ê®Æªº¦h¾l­¶­±³]©w¤@«ö¶s§R°£

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2016-10-9 20:18 ½s¿è

¦^´_ 18# simplehope


±z²Ä¤@¦¸¬O¤½¦¡­ì½L¶K¹L¨Ó¡A¦A¶K¦¨­È¡A³o´N¬O°Ñ·Ó¿ò¥¢°ÝÃD¡A
±N­ìªí¢Ï¢ä¢°§ï¦¨¡e¨øÂd¡f¡A¦A°õ¦æ±z­ì¨Óµ{¦¡¡A
¤â¤u¥h¤ñ¹ï¨âªí¢Ü¡þ¢Þ¨âÄæ­pºâµ²ªG¬Ý¬Ý¡I¡I¡I

TOP

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


    ÁÂÁ simplehope«e½úµoªí¦¹¥DÃD»P½d¨Ò
ÁÂÁ ­ã´£³¡ªL«e½ú«ü¾É
«á¾Ç¦b¦¹©«¾Ç¨ì«Ü¦hª¾ÃÑ,¤ß±oµù¸Ñ¦p¤U,½Ð¦A«ü¾É,ÁÂÁÂ

Option Explicit
Sub ¶×¥X¦a½S¸ê®Æ¨ì·s¤u§@ªí()
Dim vSht As Worksheet, R&, vR As Range, SHN$, xSht As Worksheet
'¡ô«Å§i(vSht,xSht) ¬O¤u§@ªí,(R)¬Oªø¾ã¼Æ,(vR)¬OÀx¦s®æ,(SHN)¬O¦r¦ê
Set vSht = ActiveSheet
'¡ô¥OvSht¬O²{¥Î¤u§@ªí
SHN = vSht.Name & "¶×¥X"
'¡ô¥OSHN¦r¦êÅÜ¼Æ ¬OvSht¤u§@ªí¦W¦r ³s±µ "¶×¥X"ªº¦r¦ê
On Error Resume Next
'¡ô«ü©w·íµo¥Í°õ¦æ¶¥¬q¿ù»~®É¡Acontrol ·|²¾¦Üºò±µ¦bµo¥Í¿ù»~¥BÄ~Äò°õ¦æªº»y¥y«á­±ªº »y¥y ¡C
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/on-error-statement
Set xSht = Sheets(SHN)
'¡ô¥OxSht¬O ¦W¬° SHNÅܼƦr¦êªº¤u§@ªí
On Error GoTo 0
'¡ô°±¥Î¥Ø«e¹Lµ{¤¤¤w±Ò¥Îªº¥ô¦ó¿ù»~³B²z±`¦¡¡C
If xSht Is Nothing Then
'¡ô¦pªGxShtÅÜ¼Æ §P©w¬ONothing(¨S¦³ª«¥ó)
   Set xSht = Sheets.Add(after:=Sheets(Sheets.Count))
   '¡ô¥OxSht¬O ¦b³Ì«á¤@­Ó¤u§@ªí«á­±·s¼W¤@­Óªº¤u§@ªí
   'Sheets(Sheets.Count):³Ì«á¤@­Ó¤u§@

End If
With xSht
'¡ô¥H¤U¬OÃö©óxShtÅܼƤu§@ªíªºµ{§Ç
      .Name = SHN
      '¡ô­«©R¦W¬O SHN
      .Cells.Clear
      '¡ô²M°£¥þ³¡Àx¦s®æ
      .[BK3] = vSht.[BK3].Value
      '¡ô¥O[BK3]­È¬O ²{¥Î¤u§@ªí[BK3]­È
      .[AV1] = vSht.[AV1].Value
      '¡ô¥O[AV1]­È¬O ²{¥Î¤u§@ªí[AV1]­È
      .[BI3] = vSht.[BI3].Value
      '¡ô¥O[BI3]­È¬O ²{¥Î¤u§@ªí[BI3]­È
      R = Val(vSht.[AT51]) * 52
      '¡ô¥OR ¬O ²{¥Î¤u§@ªí[AT51]­ÈÂà¤Æ¬°¼Æ­È
      'Val():¶Ç¦^¦r¦ê¤¤¥]§tªº¼Æ¦ì¡A°µ¬°¾A·íÃþ«¬ªº¼Æ­È¡C
      If R = 0 Then Exit Sub '¨ú±o­¶¼Æ
      '¡ô¦pªGR³o¼Æ¦rÅܼƬO 0,´Nµ²§ôµ{¦¡°õ¦æ
      vSht.Range("A1:AM" & R).Copy .[A1] '¶K¤W¸ê®Æ
      '¡ô²{¥Î¤u§@ªí.[A1]¨ìAMÄæR¦CÀx¦s®æ¤§¶¡½d³òÀx¦s®æ½Æ»s¨ì xShtÅܼƤu§@ªí[A1]
      .Range("A16:A" & R) = "=TEXT(COUNT(AK$16:AK16),""'000"")" '§Ç¸¹¤½¦¡
      '¡ôxShtÅܼƤu§@ªí[A16]¨ìAÄæR¦CÀx¦s®æ¤§¶¡½d³òÀx¦s®æ¦r¦ê¬O §Ç¸¹¤½¦¡
      '¤½¦¡·N¸q:§P©w«ü©wÀx¦s®æ½d³ò¬O¼Æ¦rªº®æ¼ÆÂà¤Æ¬°3½X¤å¦r,«e­±¦A¥H³æ¤Þ¸¹³s±µ
      'TEXT ¨ç¼Æ¡A¥H®æ¦¡¥N½X¨Ó®M¥Î®æ¦¡¡AÂǦ¹Åܧó¼Æ¦rÅã¥Üªº¤è¦¡¡C

      'https://support.microsoft.com/zh-tw/office/text-%E5%87%BD%E6%95%B8-20d5ac4d-7b94-49fd-bb38-93d29371225c
      'COUNT() ¨ç¼Æ¥u·|²Î­p¼Æ¦r«¬ªº¼Æ¾Ú¸ê®Æ¡A­Y¬O¸I¨ì¤å¦r¤º®eªºªí®æ¤]·|³Q©¿²¤¡C
      '¦]¬°Àx¦s®æ¦pªG¬O¤½¦¡!·|¦Û°Ê²Ö¥[¨ä¦C¦ì.Äæ¦ì©Î³£²Ö¥[,µøÄæ¦C¬O§_«a¤W"$"²Å¸¹¦Ó©w

      .Range("A1:AM" & R) = .Range("A1:AM" & R).Value '¥þ³¡¤º®e¶K¦¨­È
      '¡ô¥OxShtÅܼƤu§@ªí.[A1]¨ìAMÄæR¦CÀx¦s®æ¤§¶¡½d³òÀx¦s®æ¥þ³¡¤º®e¶K¦¨­È
      For Each vR In vSht.[A1:AM1]
      '¡ô³]¶¶°j°é!¥OvRÀx¦s®æÅܼƬO ²{¥Î¤u§@ªí¸Ì[A1:AM1]ªº¤@®æ
          .Range(vR.Address).ColumnWidth = vR.ColumnWidth 'Äæ¼e
          '¡ô¥OxShtÅܼƤu§@ªí¸Ì (vRÀx¦s®æÅܼƩҦb¦ì§})ªºÀx¦s®æ Äæ¼e¬O ¦PvRÀx¦s®æÅܼÆÄæ¼e
      Next
      .[BK3] = "": .[AV1] = "": .[BI3] = ""
      '¡ô¥OxShtÅܼƤu§@ªí¸Ì[BK3],[AV1],[BI3]Àx¦s®æ¬OªÅ®æ
End With

On Error Resume Next
'¡ô¹J¿ùÄ~Äò°õ¦æ¤£°»¿ù
With xSht.Range("AK16:AK" & R)
'¡ô¥H¤U¬OÃö©óxShtÅܼƤu§@ªí [AK16]¨ìAKÄæR¦CÀx¦s®æ¤§¶¡½d³òÀx¦s®æ ªºµ{§Ç
     .SpecialCells(xlCellTypeConstants, 22).EntireRow.Delete '§R°£¡e¤å¦r¡f®æ¾ã¦C
     '¡ô§P©wxlErrors(³æ¤¸¿ù»~­È) Or xlLogical(¨ã¦³ÅÞ¿è­Èªº³æ¤¸®æ) Or xlTextValues(¨ã¦³¤å¦rªºÀx¦s®æ)
     '½d³ò¸Ì³o´XºØ­ÈªºÀx¦s®æ©Ò¦bªº¦C§R°£

     'https://learn.microsoft.com/zh-tw/office/vba/api/excel.xlspecialcellsvalue
     .SpecialCells(xlCellTypeBlanks).EntireRow.Delete  '§R°£¡eªÅ¥Õ®æ¡f¾ã¦C
     '½d³ò¸ÌªÅ®æÀx¦s®æ©Ò¦bªº¦C§R°£,(¤£¥]§t¦³¤½¦¡µ²ªG¬°ªÅ¥Õ¦r¤¸ªºÀx¦s®æ)
End With
On Error GoTo 0
'¡ô°±¥Î¥Ø«e¹Lµ{¤¤¤w±Ò¥Îªº¥ô¦ó¿ù»~³B²z±`¦¡¡C
xSht.Select
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C&¦r¨å
µ²ªG:
2022-12-12_164152.JPG
2022-12-12 16:44


Option Explicit
Sub TEST()
Dim Brr, Crr, C&, i&, j&, xR, R&, T, V, Y, Z
Dim N&, Sh As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh = ActiveSheet
Brr = Range(Sh.[A1], Sh.Cells(Sh.UsedRange.Rows.Count, "AM"))
For i = 1 To [AM1].Column
   Y(i & "C") = Columns(i).ColumnWidth
Next
For i = 1 To 15
   Y(i & "R") = Rows(i).Rows.RowHeight
Next
For i = 16 To UBound(Brr)
   If IsNumeric(Brr(i, [AK1].Column)) And Brr(i, [AK1].Column) <> "" Then
      N = N + 1
      For j = 1 To [AM1].Column
         Brr(N, j) = Brr(i, j)
      Next
   End If
Next
Set Y("ªíÀY") = Range(Sh.[A1], Sh.[AM16])
Workbooks.Add
Y("ªíÀY").Copy [A1]
For i = 1 To [AM1].Column
   Columns(i).ColumnWidth = Y(i & "C")
Next
For i = 1 To 15
   Rows(i).Rows.RowHeight = Y(i & "R")
Next
Range([A16], [AM16]).ClearContents
Range([A16], [AM16]).Borders.LineStyle = 1
[16:16].Copy Rows("17:" & N + 15)
[A16].Resize(N, [AM1].Column) = Brr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 23# Andy2483


    ½Æ²ß&¦AÀˬd­×§ïµ{¦¡½Xµù¸Ñ¦p¤U:

Option Explicit
Sub TEST()
Dim Brr, Y, C&, i&, j&, R&, N&, Sh As Worksheet
'¡ô«Å§iÅܼÆ:(Brr, Y)¬O³q¥Î«¬,(C,i,j,R,N)¬Oªø¾ã¼Æ,(Sh)¬O¤u§@ªí
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY ¬O¦r¨å
Set Sh = ActiveSheet: N = 15
'¡ô¥OSh ¬O²{¥Î¤u§@ªí: ¥ON=15
Brr = Range(Sh.[A1], Sh.Cells(Sh.UsedRange.Rows.Count, "AM"))
'¡ô¥OBrr¬O¤Gºû°}¦C!­Ë¤J[A1]¨ì(AMÄæ/³Ì«á¦³¨Ï¥ÎªºÀx¦s®æ¨º¤@¦Cªº¦C¸¹Àx¦s®æ) ­È
For i = 1 To 39
'¡ô³]¶¶°j°é!i±q 1¨ì39
   Y(i & "C") = Columns(i).ColumnWidth
   '¡ô¥O°j°é¼Æ³s±µ"C"·íkey,item¬O°j°é¼ÆÄæ¦ìªºÄæ¼e
   Y(i & "R") = Rows(i).Rows.RowHeight
   '¡ô¥O°j°é¼Æ³s±µ"R"·íkey,item¬O°j°é¼Æ¦C¦ìªº¦C°ª
Next
For i = 16 To UBound(Brr)
'¡ô³]¥~¶¶°j°é!i±q 16¨ìBrr°}¦CÁa¦V³Ì¤j¦C¸¹¼Æ
   If IsNumeric(Brr(i, 37)) And Brr(i, 37) <> "" Then
   '¡ô¦pªGIsNumeric()¨ç¼Æ§PÂ_°j°é¦C²Ä37ÄæBrr°}¦C­È¬O¼Æ¦r,¥B¤£¬OªÅ¦r¤¸
      N = N + 1
      '¡ôN¼Æ¦rÅܼƲ֥[ 1
      For j = 1 To 39
      '¡ô³]¤º¶¶°j°é!j±q 1¨ì39
         Brr(N, j) = Brr(i, j)
         '¡ô¥ONÅܼƦC²Äj°j°éÄ檺Brr°}¦C­È¬O iÅܼƦC²Äj°j°éÄ檺Brr°}¦C­È
      Next
   End If
Next
Set Y("ªíÀY") = Range(Sh.[A1], Sh.[AM16])
'¡ô¥O¥H "ªíÀY"¦r¦ê¬°key,item¬O²{¥Î¤u§@ªí[A1]¨ì[AM16]Àx¦s®æ¶°,­Ë¤JY¦r¨å¸Ì
'¦b¶}¤@­Ó·s¬¡­¶Ã¯¤§«e§â¥Î±o¨ìªº¸ê®Æ¥Î¦r¨å»P°}¦C¸Ë°_¨Ó

'Y("ªíÀY")Àx¦s®æ¸Ì¦³¤½¦¡!
Workbooks.Add
'¡ô¶}¤@­Ó·s¬¡­¶Ã¯
Y("ªíÀY").Copy [A1]
'¡ô¥O¥H "ªíÀY"¦r¦ê¬dY¦r¨å,§âÀx¦s®æ¶°½Æ»s¨ì¦¹·s¬¡­¶Ã¯[A1]
For i = 1 To 39
'¡ô³]¶¶°j°é!i±q 1¨ì39
   Columns(i).ColumnWidth = Y(i & "C")
   '¡ô¥Hi°j°é¼Æ³s±µ"C"ªº¦r¦ê¬dY¦r¨åªºitem­È ¬°i°j°é¼ÆÄæÄæ¼e
   Rows(i).Rows.RowHeight = Y(i & "R")
   '¡ô¥Hi°j°é¼Æ³s±µ"R"ªº¦r¦ê¬dY¦r¨åªºitem­È ¬°i°j°é¼Æ¦C¦C°ª
Next
Range([A16], [AM16]).ClearContents
'¡ô[A16]¨ì[AM16]Àx¦s®æ¤º®e²MªÅ
Range([A16], [AM16]).Borders.LineStyle = 1
'¡ô[A16]¨ì[AM16]Àx¦s®æ®æ½u¬O²Ó¹ê½u
[16:16].Copy Rows("17:" & N)
'¡ô²Ä16¦C½Æ»s¨ì 17¦Ü NÅܼƦC
[A1].Resize(N, 39) = Brr
'¡ô¥O[A1]ÂX®i¦V¤UNÅܼƦC,¦V¥kÂX®i39Äæ½d³òªºÀx¦s®æ,¥HBrr°}¦C­È­Ë¤J
'Y("ªíÀY")Àx¦s®æ¸Ì¦³¤½¦¡!©Ò¥H»Ý­n¥H°}¦C­È±a¤J

Set Brr = Nothing
Set Y = Nothing
'¡ôÄÀ©ñÅܼÆ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¤H­n¦Û·R¡A¤~¯à·R´¶¤Ñ¤Uªº¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD