| ©«¤l835 ¥DÃD6 ºëµØ0 ¿n¤À915 ÂI¦W1  §@·~¨t²ÎWin 10,7 ³nÅ骩¥»2019,2013,2003 ¾\ŪÅv50 ©Ê§O¨k µù¥U®É¶¡2010-5-3 ³Ì«áµn¿ý2025-7-5 
 | 
                
| ¦^´_ 4# art00083303 ¨º´N¦b§ì¨ú¸ê®Æ®É, ¤@¨Ö«Ø¥ßµ²ªG¼ÐÃDÄd : (·íµM, ¶¶§Ç·|Åܦ¨¨Ì§ì¨ú¥ý«á±Æ¦C)
 
 
     ½Æ»s¥N½XPrivate Sub cbMerge_Click()
  Dim iI%, iJ%, iSCol%, iTCol%
  Dim lRow&
  Dim aR()
  Dim vD
  
  Rows("21:" & Rows.Count).Clear ' ²M±¼¤W¤@¦¸ªº¸ê®Æ(§t¼ÐÃDÄd)
  
  Set vD = CreateObject("Scripting.Dictionary")
  
  Cells(21, 2) = "DATE"
  Cells(21, 3) = "TIME"
  
  lRow = 22
  iTCol = 4
  For iI = 2 To 14 Step 6 '3 Óªí®æ
    iSCol = 4
    While Cells(iI, iSCol) <> "" ' Àˬd¼ÐÃDÄd
      If Not (vD.Exists(CStr(Cells(iI, iSCol)))) Then
        vD(CStr(Cells(iI, iSCol))) = iTCol
        Cells(21, iTCol) = Cells(iI, iSCol)
        iTCol = iTCol + 1
      End If
      iSCol = iSCol + 1
    Wend
    
    For iJ = 1 To 3
      With Cells(lRow, 2)
        .NumberFormat = "yyyy/m/d"
        .Value = Cells(iI + iJ, 2) ' DATE
      End With
      
      With Cells(lRow, 3)
        .NumberFormat = "hh:mm"
        .Value = Cells(iI + iJ, 3) ' TIME
      End With
      
      iSCol = 4
      While Cells(iI + iJ, iSCol) <> ""
        With Cells(lRow, vD(CStr(Cells(iI, iSCol))))
          .Value = Cells(iI + iJ, iSCol)
          .Interior.ColorIndex = Cells(iI + iJ, iSCol).Interior.ColorIndex ' ½Æ»s©³¦â
        End With
        iSCol = iSCol + 1
      Wend
      lRow = lRow + 1
    Next
  Next
End Sub
 ©ñ-a.zip (11.18 KB) | 
 |