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

[µo°Ý] Excel ³æÄæ¸ê®ÆÂà¦hÄæ

[µo°Ý] Excel ³æÄæ¸ê®ÆÂà¦hÄæ

±z¦n¡A
§Ú¦³¤@­Ó"Àˮ֪O¸¹.xlsm"Åý¨Ï¥ÎªÌ©óA1.A2.A3.A4¤À§O¿é¤J¯S©w¸ê®Æ¡A¨C4µ§¸ê®Æ¬°¤@²Õ¡C
01.jpg
2022-9-11 23:47

¥Ø«e§Ú©óFÄæ~IÄæ¹w³]¦nªíÀY»P¤½¦¡¦Ü201¦C(¨Ì¸gÅç³Ì¦h¬O50²Õ+ªíÀY1¦C)¡AµM«á°õ¦æ§Ú¿ý»s¨Ã­×§ï¹Lªº¥¨¶°¥t¦s·sÀÉ©ó®à­±(ÀɦWÅÞ¿è¬O¤ë¤ë¤é¤é-®É®É¤À¤À.xlsx)¡C
¦ý¬O³o¼Ë¨C¦¸³£­n§R°£·sÀɤ¤Àx¦s®æ­È¬°0ªº¸ê®Æ¡A¤~¥i¥H¥¿±`¦C¦L¡A¤£µM·|®ö¶O«Ü¦h¯È±i¡C
03.jpg
2022-9-11 23:52

©³¤U¬O§Úªº¥¨¶°¥N½X¡G
  1. Sub Step01()

  2. M1 = Format(Now, "MM")
  3. D1 = Format(Now, "DD")
  4. H1 = Format(Now, "HH")
  5. N1 = Format(Now, "NN")

  6.     Columns("F:I").Select
  7.     Selection.Copy
  8.     Workbooks.Add
  9.     Columns("A:A").Select
  10.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  11.         :=False, Transpose:=False
  12.     Application.CutCopyMode = False
  13.     ActiveWorkbook.SaveAs Filename:="C:\Users\Point\OneDrive\®à­±\" & M1 & D1 & "-" & H1 & N1 & ".xlsx"
  14. End Sub
½Æ»s¥N½X
½Ð±Ð«e½ú¥i¥HÀ°§Ú­×§ï¦¨¡A¥ý§PÂ_C13Àx¦s®æ¬O¼Æ¦r(¦pªG¤£¬O¼Æ¦rªí¥Ü¿é¤J¸ê®Æ¤£§¹¥þ¡A«h¤£°õ¦æµ{¦¡)¡A¦p¬O«h±N"Àˮ֪O¸¹.xlsm"ªºAÄæ¸ê®Æ¡A¤À§O¥á¨ì·sÀɪºAÄæ~DÄæ¡A¨Ã¦sÀɶܡC
·PÁ¡C
Àˮ֪O¸¹.rar (24.68 KB)

±z¦n¡A
§Ú¦³¤@­Ó"Àˮ֪O¸¹.xlsm"Åý¨Ï¥ÎªÌ©óA1.A2.A3.A4¤À§O¿é¤J¯S©w¸ê®Æ¡A¨C4µ§¸ê®Æ¬°¤@²Õ¡C

¥Ø«e§Ú©óF ...
pointchi µoªí©ó 2022-9-11 23:58


·s¼W¦p¤U¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ


Sub Step01()

M1 = Format(Now, "MM")
D1 = Format(Now, "DD")
H1 = Format(Now, "HH")
N1 = Format(Now, "NN")

    Columns("F:I").Select
    Selection.Copy
    Workbooks.Add
    Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Dim xR As Range, xU As Range
For Each xR In ActiveSheet.Range("C:C").SpecialCells(xlCellTypeConstants).Rows
    If Not IsError(Application.Match(0, xR, 0)) Then
        If xU Is Nothing Then Set xU = xR Else Set xU = Union(xR, xU)
     End If
Next
If Not xU Is Nothing Then xU.EntireRow.Delete


   
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:="C:\Users\Point\OneDrive\®à­±\" & M1 & D1 & "-" & H1 & N1 & ".xlsx"
End Sub

TOP

¦^´_ 2# samwang
S¤j±z¦n¡A
«e¤å®Ñ¼g¤£²M·¡¡A§Úªº·N«ä¬O¦bFÄæ~IÄ椣¹w³]¦nªíÀY»P¤½¦¡ªº«e´£¤U¡Aª½±µ±N"Àˮ֪O¸¹.xlsm"ªºAÄæ¸ê®Æ¡Aª½±µÅã¥Ü©ó·sÀɪºAÄæ~DÄæ¡A¨Ã¦sÀÉ¡C
01.jpg
2022-9-13 11:02

TOP

google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

¦^´_ 1# pointchi


    ÁÂÁ«e½úµoªí¦¹©«
½Ð¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub TEST()
  3. Dim MDHN, i, Arr, Brr
  4. MDHN = Format(Now, "MMDD-HHNN")
  5. Arr = Range([A1], Cells(Rows.Count, "A").End(3))
  6. ReDim Brr(1 To UBound(Arr) / 4, 1 To 4)
  7. For i = 1 To UBound(Arr)
  8.    If i Mod 4 Then
  9.       Brr(Int(i / 4) + 1, (i Mod 4)) = Arr(i, 1)
  10.       Else
  11.          Brr(Int(i / 4), 4) = Arr(i, 1)
  12.    End If
  13. Next
  14. Workbooks.Add
  15. [A1].Resize(1, 4) = Array("®Æ¸¹", "¼Æ¶q", "ªO¸¹", "Àx¦ì")
  16. [A2].Resize(UBound(Brr), 4) = Brr
  17. [A:D].Columns.AutoFit
  18. ActiveWorkbook.SaveAs Filename:="C:\Users\Point\OneDrive\®à­±\" & MDHN & ".xlsx"
  19. End Sub
½Æ»s¥N½X

TOP

¦^´_ 4# hcm19522
H¤j¡A
§Ú·í®Éªº¤½¦¡¤]¬O±q±z¨ºÃä¾Ç¨Óªº¡C
¦Ó¥B§Ú±`±`§ä¸ê®Æ®É¤]³£¥X²{±zªºBLOG¡A±q±z¨º«õ¥X«Ü¦h«Ü¼F®`ªº¤½¦¡¸Ñªk¡C

TOP

¦^´_ 5# Andy2483
Andy­ô¡A
·PÁ±zªºµ{¦¡¤ä´©¥i¥H¶¶§Q°õ¦æ¡C

TOP

¦^´_ 3# pointchi

­É¥ÎAndy2483«e½åµ{¦¡½X¡A­×§ï¤@¤U¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim MDHN, i&, Arr, Brr, R&, C%
MDHN = Format(Now, "MMDD-HHNN")
Arr = Range([A1], Cells(Rows.Count, "A").End(3))
ReDim Brr(1 To UBound(Arr) / 4, 1 To 4)
For i = 1 To UBound(Arr)
    C = C + 1: Brr(R + 1, C) = Arr(i, 1)
    If C = 4 Then C = 0: R = R + 1

Next
Workbooks.Add
[A1].Resize(1, 4) = Array("®Æ¸¹", "¼Æ¶q", "ªO¸¹", "Àx¦ì")
[A2].Resize(UBound(Brr), 4) = Brr
[A:D].Columns.AutoFit
ActiveWorkbook.SaveAs Filename:="C:\Users\Point\OneDrive\®à­±\" & MDHN & ".xlsx"
End Sub

TOP

¦^´_ 8# samwang
·PÁÂS¤j¡A
±zªºµ{¦¡½X¤]¥i¥H¶¶§Q¹B§@¡C

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-9-17 10:21 ½s¿è

¦^´_ 7# pointchi


    ÁÂÁ«e½ú¦^ÂÐ
    ÁÂÁÂsamwang«e½ú«ü¾É
¦A²ß±o IIf( )  ¨ú¥N  if ~else~

Option Explicit
Sub TEST1()
Dim MDHN, i, Arr, Brr, R, C
MDHN = Format(Now, "MMDD-HHNN")
Arr = Range([A1], Cells(Rows.Count, "A").End(3))
ReDim Brr(1 To UBound(Arr) / 4, 1 To 4)
For i = 1 To UBound(Arr)
   C = IIf(i Mod 4, i Mod 4, 4)
   R = IIf(C = 1, R + 1, R)
   Brr(R, C) = Arr(i, 1)

Next
Workbooks.Add
[A1].Resize(1, 4) = Array("®Æ¸¹", "¼Æ¶q", "ªO¸¹", "Àx¦ì")
[A2].Resize(UBound(Brr), 4) = Brr
[A:D].Columns.AutoFit
ActiveWorkbook.SaveAs Filename:="C:\Users\Point\OneDrive\®à­±\" & MDHN & ".xlsx"
End Sub

TOP

        ÀR«ä¦Û¦b : «H¤ß¡B¼Ý¤O¡B«i®ð¤TªÌ¨ã³Æ¡A«h¤Ñ¤U¨S¦³°µ¤£¦¨ªº¨Æ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD