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

[µo°Ý] °õ¦æ³t«×¹LºC ¦p¦ó²¤Æ

¥»©«³Ì«á¥Ñ stillfish00 ©ó 2015-4-15 20:16 ½s¿è

¦^´_ 7# lyc43210
Delete/Copy ³o¨Ç°Ê§@³£¤ñ¸ûºC , ¸ê®Æ¶q¤j®ÉºÉ¶q¤Ö¥Î
  1. '°²³]¨C¦æ³Ì¤Ö³£¦³¤@µ§¸ê®Æ
  2. Sub Test()
  3.     Dim arSrc, arDes, m As Long, n As Long
  4.    
  5.     With ActiveSheet
  6.         arSrc = .[a1].CurrentRegion.Value
  7.         If UBound(arSrc) Mod 2 = 1 Then MsgBox "¸ê®Æ«D°¸¼Æ¦æ": Exit Sub
  8.         ReDim arDes(1 To UBound(arSrc) / 2, 1 To UBound(arSrc, 2))
  9.         
  10.         n = 1: m = 1
  11.         For i = 1 To UBound(arSrc)
  12.             For j = 1 To UBound(arSrc, 2)
  13.                 If arSrc(i, j) = "" Then
  14.                     Exit For
  15.                 Else
  16.                     If n > UBound(arDes, 2) Then ReDim Preserve arDes(1 To UBound(arDes), 1 To n)
  17.                     arDes(m, n) = arSrc(i, j)
  18.                     n = n + 1
  19.                 End If
  20.             Next
  21.             If i Mod 2 = 0 Then n = 1 : m = m + 1
  22.         Next
  23.     End With
  24.    
  25.     '³B²z§¹«áªº¸ê®Æ·s¼W¤u§@ªí¶K¤W
  26.     With Sheets.Add
  27.         .[a1].Resize(UBound(arDes), UBound(arDes, 2)).Value = arDes
  28.     End With
  29.    
  30. End Sub
½Æ»s¥N½X
ªí¹F¤£²M¡BÃD·N¤£©ú½T¡B¨SªþÀɮ׮榡¡B¨S¦³°Q½×°ÝÃDªººA«×~~~~~~¥H¤W·R²ö¯à§U¡C

TOP

        ÀR«ä¦Û¦b : ¥@¤W¦³¨â¥ó¨Æ¤£¯àµ¥¡G¤@¡B§µ¶¶ ¤G¡B¦æµ½¡C
ªð¦^¦Cªí ¤W¤@¥DÃD