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

[µo°Ý] ½s¸¹«e¤C½X¬Û¦PªÌ¥u­n¾P®×¤éªÅ­È«h¨ä¥Lª©¦¸¬Ò§R°£

[µo°Ý] ½s¸¹«e¤C½X¬Û¦PªÌ¥u­n¾P®×¤éªÅ­È«h¨ä¥Lª©¦¸¬Ò§R°£

DEAR ALL ¤j¤j
1.¸ê®Æ®w¦p¹Ï¤@
2.»Ý¨D-½s¸¹«e¤C½X¬Û¦PªÌ¥u­n¾P®×¤éªÅ­È«h¨ä¥Lª©¦¸¬Ò§R°£
2.1 ¨Ò: C123456 »P C123456A ²Õ.¦] ¾P®×¤é¬Ò¦³­È¬°¦P¤@¬G«O¯d.
          D123456 »P D123456A »P D123456B ¬°¦P¤@²Õ¦]D123456B¾P®×¤é¬°ªÅ¥Õ¬GALL§R°£
       E123456 »P E123456A ¬°¦P¤@²Õ¦]E123456¾P®×¤é¬°ªÅ¥Õ¬GALL§R°£
2.2 µ²ªG¦p¹Ï¤G
3.·Ð¤£§[½ç±Ð  THANKS*10000

¹Ï¤@
½s¸¹         ¶µ¥Ø   ¨Ï¥ÎªÌ     ¦¬¥ó¤é           ¾P®×¤é
C123456      1        1          2017/08/04        2017/08/12
C123456A      1        1          2017/08/04        2017/08/12
D123456        1        1          2017/08/04        2017/08/12
D123456A      1        1          2017/08/04        2017/08/12
E123456        1        1          2017/08/04         
D123456B      1        1          2017/08/04
E123456A      1        1          2017/08/05        2017/08/06

¹Ï¤G
C123456        1        1          2017/08/04        2017/08/12
C123456A      1        1          2017/08/04        2017/08/12
ù

ÀH·NºÛ "EXCEL°g"  blog  ©Îhttps://hcm19522.blogspot.com/ EXCEL¨ç¼Æ

TOP

DEAR  ¤j¤j
SORRY ¥¼»¡²M³B
¤p§Ì¬O­n¨Ï¥ÎVBA
­ì¹Ï¤@¸ê®Æ®w©ó   SHEET1
­n±N¹Ï¤G¸ê®Æ¾É¤J SHEET2
ù

TOP

DEAR ALL ¤j¤j
¤p§Ì¤À¦p¤U4²Õ¤è§¹¦¨
½Ð±Ð¦p¦ó¤@²ÕVAB§Y§¹¦¨¤§¤è¦¡ ·Ð¤£§[½ç±Ð

Sub ±ø¥ó¸ê®Æ®wA()
Application.Run "±ø¥ó¸ê®Æ®wA1"
Application.Run "±ø¥ó¸ê®Æ®wA2"
Application.Run "±ø¥ó¸ê®Æ®wA3"
Sheet3.[a2:f65536].ClearContents
  X = Sheet1.[A65536].End(xlUp).Row
  Y = Sheet3.[A65536].End(xlUp).Row
For M = 2 To X
If Sheet1.Cells(M, 9) = 0 Then
  Sheet3.Cells(Y + 1, 1).Resize(, 6).Value = Sheet1.Cells(M, 1).Resize(, 6).Value
    Y = Y + 1
End If
Next
End Sub

Sub ±ø¥ó¸ê®Æ®wA1()
Sheet1.[G2:G65536].ClearContents
X = Sheet1.[A65536].End(xlUp).Row
For M = 2 To X
  Sheet1.Cells(M, 7) = Mid(Sheet1.Cells(M, 1), 1, 7)
  Next
End Sub

Sub ±ø¥ó¸ê®Æ®wA2()
Sheet1.[H2:H65536].ClearContents
X = Sheet1.[A65536].End(xlUp).Row
For M = 2 To X
  If Sheet1.Cells(M, 5) = "NULL" Or Sheet1.Cells(M, 5) = "" Or Sheet1.Cells(M, 5) = " " Then
    Sheet1.Cells(M, 8) = Sheet1.Cells(M, 7)
  End If
  Next
End Sub

Sub ±ø¥ó¸ê®Æ®wA3()
Sheet1.Select
Range("A1").Select
Sheet1.[I2:I65536].ClearContents
X = Sheet1.[A65536].End(xlUp).Row
For M = 2 To X
   Sheet1.Cells(M, 9) = Application.CountIf(Sheet1.Range("H:H"), Sheet1.Cells(M, 7))
Next
End Sub
ù

TOP

¦^´_ 4# rouber590324
¸Õ¸Õ¬Ý
  1. Sub ex()
  2. Dim A As Range
  3. Set d = CreateObject("Scripting.Dictionary")
  4. With Sheets(1)
  5. For Each A In .Range(.[A1], .[A1].End(xlDown))
  6.   If d(Left(A, 7)) = "" Then
  7.      d(Left(A, 7)) = Join(Application.Transpose(Application.Transpose(A.Resize(, 5))), ";")
  8.      Else
  9.      d(Left(A, 7)) = d(Left(A, 7)) & Chr(10) & Join(Application.Transpose(Application.Transpose(A.Resize(, 5))), ";")
  10.   End If
  11. Next
  12. For Each ky In d.keys
  13.   ar = Split(d(ky), Chr(10))
  14.   For Each c In ar
  15.      If Split(c, ";")(4) = "" Then d.Remove ky
  16.   Next
  17. Next
  18. On Error Resume Next
  19. For Each ky In d.keys
  20.   ar = Split(d(ky), Chr(10))
  21.   For Each c In ar
  22.   ay = Split(c, ";")
  23.   ay(3) = CDate(ay(3))
  24.   ay(4) = CDate(ay(4))
  25.     Sheets(2).Cells(r + 1, 1).Resize(, 5) = ay
  26.     r = r + 1
  27.   Next
  28. Next
  29. End With
  30. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 3# rouber590324
½Ð°Ñ¦Ò¡C
¨Ì½s¸¹¾P®×.rar (17.64 KB)

TOP

DEAR Hsieh ¤j¤j
1.¥X²{«¬ºA¤£²Å¦X¤§BUG°±©óay(3) = CDate(ay(3))????

DEAR Kubi ¤j¤j
¤p§Ì¨Ï¥Î¤½¥q¹q¸£µLªk¤U¸ü.rarÀÉ®×.ÁÙ¬O·PÁ±z¦^ÂÐ.

Sub ±ø¥ó¸ê®Æ®wA4()
Dim A As Range
Set d = CreateObject("Scripting.Dictionary")
With Sheets(1)
For Each A In .Range(.[A1], .[A1].End(xlDown))
  If d(Left(A, 7)) = "" Then
     d(Left(A, 7)) = Join(Application.Transpose(Application.Transpose(A.Resize(, 5))), ";")
     Else
     d(Left(A, 7)) = d(Left(A, 7)) & Chr(10) & Join(Application.Transpose(Application.Transpose(A.Resize(, 5))), ";")
  End If
Next
For Each ky In d.keys
  ar = Split(d(ky), Chr(10))
For Each c In ar
     If Split(c, ";")(4) = "" Then d.Remove ky
  Next
Next
'On Error Resume Next
For Each ky In d.keys
  ar = Split(d(ky), Chr(10))
  For Each c In ar
  ay = Split(c, ";")
  ay(3) = CDate(ay(3))
  ay(4) = CDate(ay(4))
    Sheets(2).Cells(r + 1, 1).Resize(, 5) = ay
    r = r + 1
  Next
Next
End With
End Sub
ù

TOP

DEAR Hsieh ¤j¤j
SORRY ¤w§ä¨ì°ÝÃD.·PÁ±z¤§«ü¾É THANKS*10000
ù

TOP

        ÀR«ä¦Û¦b : ¡i°±º¢¤£«e¡A²×µL©Ò±o¡j¤H³£°g©ó´M§ä©_ÂÝ¡A¦]¦Ó°±º¢¤£«e¡FÁa¨Ï®É¶¡¦A¦h¡B¸ô¦Aªø¡A¤]¤FµL¥Î³B¡A²×µL©Ò±o¡C
ªð¦^¦Cªí ¤W¤@¥DÃD