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

[µo°Ý] «ö«ü©w¦¸¼Æ­«½Æ¼Æ¾Ú

[µo°Ý] «ö«ü©w¦¸¼Æ­«½Æ¼Æ¾Ú

¦U¦ì«e½ú¦n~§Ú¦³¤@±i¶µ¥Ø¤ÀÅu©³½Z¡A§Æ±æ«ö¦³°Ñ»P¶µ¥Ø¤ÀÅuªº¦¸¼Æ­«½ÆºK­nÄæ¨Ã±N¤ÀÅuª÷ÃB¶ñ¤J¡A

¦p¹Ï

«ö«ü©w¦¸¼Æ­«½Æ¼Æ¾Ú.png
2024-10-17 23:39
¡A½Ð°Ý¦bL3~N3¸Ó¦p¦ó¤U¤½¦¡¡AÁÂÁÂ

«ü©w¦¸¼Æ­«½Æ¼Æ¾Ú.zip (9.85 KB)

¦^´_ 1# shootingstar


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò,«á¾ÇÂǦ¹©«½m²ßVBA°}¦Cªº¤è®×,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 10000, 1 To 3), i&, j%, R&, T$
Brr = Range([I2], Cells(Rows.Count, 1).End(3))
For i = 2 To UBound(Brr)
   T = Brr(i, 1)
   For j = 2 To UBound(Brr, 2)
      If Val(Brr(i, j)) <> 0 Then
         R = R + 1
         Crr(R, 1) = T
         Crr(R, 2) = Brr(1, j)
         Crr(R, 3) = Val(Brr(i, j))
      End If
   Next
Next
Intersect(ActiveSheet.UsedRange.Offset(2, 11), [L:N]).ClearContents
If R = 0 Then Exit Sub
[L3:N3].Resize(R) = Crr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

«DªÅ Âà¸m¤TÄæ(·j´M¿é¤J½s¸¹ 13268) googleºô§}:https://hcm19522.blogspot.com/
google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

        ÀR«ä¦Û¦b : ¤Ó¶§¥ú¤j¡B¤÷¥À®¦¤j¡B§g¤l¶q¤j¡A¤p¤H®ð¤j¡C
ªð¦^¦Cªí ¤W¤@¥DÃD