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

[µo°Ý] ½Æ»s¶K¤W°ÝÃD

[µo°Ý] ½Æ»s¶K¤W°ÝÃD

VBA·s¤â¡A½Ð±Ð¤j¤j­Ì¡A¤U¦C½Æ»s¸ê®Æ¡A­n«ç»ò¨Ï¥ÎVBA§¹¦¨
AA ¬¡­¶¤¤¡A­n§â A Äæ 5¡B6¡B24 °Ï¶¡ªº¸ê®Æ¡A¤À§O½Æ»s¨ì T5¡BT6¡BT24 ¬¡­¶ªº A2 Äæ¦ì¯Â¤å¦r¶K¤W
¥t¥~¡A·í AA ¬¡­¶¤¤¡AA Äæ¥u¦³ 5¡B24 °Ï¶¡ªº¸ê®Æ¡A¤À§O½Æ»s¨ì T5¡BT24 ¬¡­¶ªº A2 Äæ¦ì¯Â¤å¦r¶K¤W¡A¦p¦óÁקK error

AA

AA.PNG

T5

T5.PNG

T6

T6.PNG

T24

T24.PNG

1015.zip (8.22 KB)

1015

§Ú©ñ¦b Open ¸Ì, §A¦A¦Û¤v§ï©ñ¨ì§A­nªº Sub ¸Ì :
  1.   Dim lRow&, lRows&
  2.   Dim sStr$
  3.   Dim dTar
  4.   Dim wsTar As Worksheet
  5.    
  6.   Set dTar = CreateObject("Scripting.Dictionary") ' ·j´MÃöÁä¦r
  7.   
  8.   For Each wsTar In Worksheets ' ¹M¾ú©Ò¦³¤u§@ªí
  9.     sStr = wsTar.Name ' ¤u§@ªí¦WºÙ
  10.     If Left(sStr, 1) = "T" Then
  11.       Worksheets(sStr).Cells.ClearContents ' ²M°£ "T" ¶}ÀYªº¤u§@ªí¤º®e
  12.       dTar(sStr) = sStr ' ¬ö¿ý "T" ¶}ÀYªº¤u§@ªí¦WºÙ,ÁקKµo¥Í§ä¤£¨ì¤u§@ªíªº¿ù»~
  13.     End If
  14.   Next
  15.   
  16.   With Worksheets("AA")
  17.     lRows = .Cells(Rows.Count, 1).End(xlUp).Row ' §ä³Ì¥½¦C
  18.     lRow = 1
  19.    
  20.     Do While lRow <= lRows
  21.       sStr = "T" & .Cells(lRow, 1) ' ¤u§@ªí¦WºÙ
  22.       If dTar(sStr) <> "" Then ' §ä¨ì¹ïÀ³¤u§@ªí
  23.         .Cells(lRow, 1).CurrentRegion.Copy ' °Ï¶ô½Æ»s
  24.         Worksheets(sStr).[A2].PasteSpecial Paste:=xlPasteValues ' ¦b¹ïÀ³¤u§@ªíªº A2 ¶K¤W­È
  25.         lRow = lRow + .Cells(lRow, 1).CurrentRegion.Rows.Count - 1 ' ¸õ¹L¤w³B²zªº°Ï¶ô
  26.       End If
  27.       lRow = lRow + 1
  28.     Loop
  29.   End With
½Æ»s¥N½X
1015_ans.zip (22 Bytes)

TOP

¥»©«³Ì«á¥Ñ cyfchuang ©ó 2024-10-16 08:25 ½s¿è

¥i¥H¨Ï¥Î¡A¦Ó¥BÁÙ¦³¸Ô²Óªºµù¸Ñ¡A¾A¦X·s¤â¾Ç²ß¡AÁÂÁ @luhpro ¤j¤jªºÀ°¦£

TOP

        ÀR«ä¦Û¦b : ¬O«D·í±Ð¨|¡AÆg¬ü§@ĵ±§¡C
ªð¦^¦Cªí ¤W¤@¥DÃD