billchenfantasy

¦^´_ 9# Hsieh


¤£¦n·N«äÃö©ó³o½gªº©µ¦ù¥i¥H¦A½Ð±Ð±z¥H¤Uªº°ÝÃD¶Ü
³o¬O§Ú©µÄò³o½gµªÂЦۦæ§ó§ï¼¶¼g¥ÑVBA¶]¥Xªºµ²ªG       
¸ê®ÆÄæ¡B¦Cªø«×¤£¤@©w¦ý©T©w¥ÑD³oÄd°_©l       
½Ð°Ý­n«ç»ò¦bµ{¦¡§ÀºÝ¦b¥[´X¶µÅýDÄd«á©Ò¦³¸ê®Æ¦bMDATE_T³oÄd¾ã²z¦¨¥ªÃäMDATEªº®æ¦¡       
1        ¦Û°Ê¿ï¾ÜDÄd¥H«áÄd¡B¦C¤W¦³¸ê®Æªº¥þ³¡½d³ò
2        ¦bC2¤U¤è¦X¨Ö°_¨Ó
°ÝÃD.rar (9.06 KB)

¤U¸ü¦¸¼Æ: 7

2013-3-7 14:39

Hsieh

¦^´_ 11# billchenfantasy
¬O³o­Ó·N«ä¶Ü?

1. Sub ex()
   
2. Dim Ar()
   
3. r = 2
   
4. Do Until Application.CountA(Range(Cells(r, 4), Cells(r, Columns.Count))) = 0
   
5.    Set a = Cells(r, "D")
   
6.    Set rng = Range(a, Cells(r, Columns.Count)).SpecialCells(xlCellTypeConstants)
   
7.    For Each c In rng
   
8.    ReDim Preserve Ar(s)
   
9.    Ar(s) = Format(c, "yyyy/m/d")
   
10.    s = s + 1
    
11.    Next
    
12.    a.Offset(, -1) = Join(Ar, " ")
    
13.    Erase Ar: s = 0
    
14.    r = r + 1
    
15. Loop
    
16. End Sub

½Æ»s¥N½X

billchenfantasy

¦^´_ 12# Hsieh
@@®¦...½Ð°Ý¬O­n§â¥Lª½±µ±µ¦b­ì¥»ªºµ{¦¡½X«á­±¶Ü¡A­ì¥»¥X²{­«½Æ«Å§iªºBOX¡A©Ò¥H§Ú´N§âDIM²¾¨ì«e­±¶}ÀY¡A¥i¥H°õ¦æ¡Aµ²ªG®æ¦¡¤@¼Ë¡A¦ý¬O¥Á°ê¥þÅܦ¨¦è¤¸¤F¡A§Ú¬O·Q«O¯d¥Á°ê¤é´Á¡A±N¨ä¾ã²z¦¨MDATE¨ºÄd¤@¼Ë¡C

Hsieh

¦^´_ 13# billchenfantasy

·s°ÝÃDªºA¡BBÄæ¸ê®Æ¬O²Ä¤@­Ó°ÝÃD¾ã²zµ²ªG¡A¦ý¬OEÄõ¥H«áªº¸ê®ÆÀ³¸Ó¬O¥t¥~¿é¤J
©Ò¥HÀ³¸Ó¬O¤À¦¨¨â­Óµ{§Ç°õ¦æ¤~¹ï§a
¦Ü©ó­n«O«ù¥Á°ê¦~®æ¦¡

1. Sub ex()
   
2. Dim Ar()
   
3. r = 2
   
4. Do Until Application.CountA(Range(Cells(r, 4), Cells(r, Columns.Count))) = 0
   
5.    Set a = Cells(r, "D")
   
6.    Set Rng = Range(a, Cells(r, Columns.Count)).SpecialCells(xlCellTypeConstants)
   
7.    For Each c In Rng
   
8.    ReDim Preserve Ar(s)
   
9.    Ar(s) = Format(c, "e/m/d")
   
10.    s = s + 1
    
11.    Next
    
12.    a.Offset(, -1) = Join(Ar, " ")
    
13.    Erase Ar: s = 0
    
14.    r = r + 1
    
15. Loop
    
16. End Sub

½Æ»s¥N½X

billchenfantasy

¦^´_ 14# Hsieh
·PÁ±zªºÀ°§U¥i¥H¶¶§Q°õ¦æ¤F~ ÁÂÁÂ

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æ«e:

¤U¸ü (151.91 KB)

2023-4-12 16:20

°õ¦æµ²ªG:

¤U¸ü (183.74 KB)

2023-4-12 16:20

Option Explicit
Sub TEST()
Dim Brr, i&, j&, T$, xR As Range, Sh As Worksheet
Set Sh = Sheets("¤u§@ªí1")
Set xR = Range(Sh.[C1], Intersect(Sh.[D1].CurrentRegion, [D:G]))
Intersect(xR, [C:C]).ClearContents: Brr = xR
For i = 1 To UBound(Brr)
   T = Brr(i, 1)
   For j = 2 To UBound(Brr, 2)
      T = Replace(T & " " & Format(Brr(i, j), "e/m/d"), "  ", " ")
   Next
   Brr(i, 1) = Trim(T)
Next
xR = Brr
Set xR = Nothing: Set Sh = Nothing: Erase Brr
End Sub