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

[µo°Ý] ½Ð±Ð¡A¦p¦ó½Æ»s¤£¦P¤u§@ªí¯S©wÄæ¦ì(©¿²¤ªÅ¥Õ­È)¨ì¤@­Ó¤u§@ªí¤W

¦^´_ 1# edmondsforum

¸Õ¸Õ¬Ý¬O§_²Å¦X
Sub ex()
Dim sht As Object
Dim r%
r = 6
Sheets("³æ»ù¤ÀªRÁ`ªí").Cells.Clear
For Each sht In Worksheets
   If sht.Name Like "*³æ»ù¤ÀªR" Then
      With Sheets(sht.Name)
         .Range(.[b2], .Cells(.[c65535].End(3).Row, 8)).Copy Sheets("³æ»ù¤ÀªRÁ`ªí").Cells(r, 2)     
         r = r + .[c65535].End(3).Row
      End With
   End If
Next
With Sheets("³æ»ù¤ÀªRÁ`ªí")
   .Cells.Font.Name = "µØ±dÁõ®ÑÅéW5"
   .[b5].Value = "¶µ¦¸"
   .[b5].HorizontalAlignment = xlCenter
   With .Range("B2:H2")
      .Merge
      .Value = "·PÁ³»¶®a±Ú°Q½×ª©"
      .HorizontalAlignment = xlCenter
      .Font.Bold = True
      .Font.Size = 16
   End With
   With .Range("B3:H3")
      .Merge
      .Value = "³æ»ù¤ÀªRªí"
      .HorizontalAlignment = xlCenter
      .Font.Underline = xlUnderlineStyleSingle
      .Font.Size = 14
   End With
   .Range("c4:H4").Merge
   .[c4].Value = "¤uµ{¦WºÙ¡G³Â»¶®a±Ú°Q½×ª©"
   .Range("c5:H5").Merge
   .[c5].Value = "¤uµ{½s¸¹¡GExcelvba"
   .Range(.[b6], .Cells(.[c65535].End(3).Row, 8)) = .Range(.[b6], .Cells(.[c65535].End(3).Row, 8)).Value  
   .Columns("A:I").AutoFit
End With
End Sub

TOP

¥»©«³Ì«á¥Ñ jcchiang ©ó 2020-7-29 10:51 ½s¿è

¦^´_ 4# edmondsforum


­ã¤j¤w¸gÂI¥X«Ü¦h¥i¯àªº°ÝÃD,¥ý¥HÀɮתº¸ê®Æ°µµ{¦¡½Õ¾ã,¨ä¾l³¡¥÷½Ð¦Û¦æ­×§ï

Sub ex1()
Dim arr, a, c, B%, QQ%, R%
Dim sht As Object
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
Sheets("³æ»ù¤ÀªRÁ`ªí").Cells.Clear
arr = Array("¤@", "¤G", "¤T", "¥|", "¤­")  '¤uµ{¶µ¦¸
For Each sht In Worksheets
   If sht.Name Like "*³æ»ù¤ÀªR" Then
      With Sheets(sht.Name)
         For Each a In .Range(.[b2], .[b65535].End(3))
            For x = 0 To UBound(arr)
               If a.Value = arr(x) And Not d.Exists(a.Value) Then d.Add a.Value, sht.Name & "@" & a.Address   
            Next
         Next
      End With
   End If
Next
R = 6
For Each a In arr
   For B = 0 To d.Count - 1
      If a = d.keys()(B) Then
         c = Split(d.items()(B), "@")
         With Sheets(c(0))
            For QQ = 1 To 100
               If .Range(c(1)).Offset(QQ, 1) = "¤p ­p" Then Exit For
            Next
            .Range(c(1)).Resize(QQ + 2, 8).Copy Sheets("³æ»ù¤ÀªRÁ`ªí").Cells(R, 2)
            R = R + QQ + 3
         End With
       End If
      Next
   Next
With Sheets("³æ»ù¤ÀªRÁ`ªí")
   .Cells.Font.Name = "µØ±dÁõ®ÑÅéW5"
   .Cells.Font.ColorIndex = 1
   .[b5].Value = "¶µ¦¸"
   .[b5].HorizontalAlignment = xlCenter
   With .Range("B2:H2")
      .Merge
      .Value = "·PÁ³»¶®a±Ú°Q½×ª©"
      .HorizontalAlignment = xlCenter
      .Font.Bold = True
      .Font.Size = 16
   End With
   With .Range("B3:H3")
      .Merge
      .Value = "³æ»ù¤ÀªRªí"
      .HorizontalAlignment = xlCenter
      .Font.Underline = xlUnderlineStyleSingle
      .Font.Size = 14
   End With
   .Range("c4:H4").Merge
   .[c4].Value = "¤uµ{¦WºÙ¡G³Â»¶®a±Ú°Q½×ª©"
   .Range("c5:H5").Merge
   .[c5].Value = "¤uµ{½s¸¹¡GExcelvba"
   .Range(.[b6], .Cells(.[c65535].End(3).Row, 8)) = .Range(.[b6], .Cells(.[c65535].End(3).Row, 8)).Value
End With
Set d = Nothing
End Sub

TOP

        ÀR«ä¦Û¦b : §Ú­Ì­n°µ¦nªÀ·|ªºÀô«O¡A¤]­n°µ¦n¤º¤ßªºÀô«O¡C
ªð¦^¦Cªí ¤W¤@¥DÃD