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

½Ð°Ý¦p¦ó¥ÎVBA.¦Û°Ê¦X¨ÖÀx¦s®æ"¸ó¦C¸m¤¤"

½Ð°Ý¦p¦ó¥ÎVBA.¦Û°Ê¦X¨ÖÀx¦s®æ"¸ó¦C¸m¤¤"

ª¦¤å¹L¤@¯ë°Ï  ¬Ý¨ìÃþ¦üªº°ÝÃD¦n¹³¨ç¼ÆµLªk¸Ñ¨M
©Ò¥H¨ìµ{¦¡°Ï¨Ó½Ð¨DÀ°¦£

¦p¹Ï
¦³¤°»ò¿ìªk  ¥i¥HÅý¹Ï¤ù¥ªÃäAÄæ¸òBÄæ  ¸ó¦C¸m¤¤  ¸ò¹Ï¤ù¥kÃäGÄæ¸òHÄæ¤@¼Ë
¦³¨Ï¥Î¿ý»s¥¨¶°ªº¤èªk  ¦ý¦]¬°¨C±i¤u§@ªí­n¸ó¦C¸m¤¤ªºªÅ¹j¼Æ¤£¦P   ¸ê®Æªº¦h¹è¤]¤£¦P
©Ò¥H¥Î¿ý»sªº¤èªk¤]¤£¦æ

Àµ½Ð¦U°Ý¤j¤jÀ°¦£
¸ó¦C¸m¤¤.rar (2.22 KB)

  1. Sub test()
  2.     Dim lngRowCount As Long
  3.     Dim lngRowCounter As Long
  4.     Dim lngRowCountLast As Long
  5.    
  6.     lngRowCount = Range("C1").End(xlDown).Row
  7.    
  8.     If lngRowCount = 2 Then Exit Sub
  9.     lngRowCountLast = 1
  10.    
  11.    
  12.     For lngRowCounter = 2 To lngRowCount - 1
  13.         With Range("A1")
  14.             If lngRowCounter = lngRowCount - 1 And Not (lngRowCountLast = lngRowCounter - 1) Then
  15.                 Range(.Offset(lngRowCountLast), .Offset(lngRowCounter)).Merge
  16.                 Range(.Offset(lngRowCountLast, 1), .Offset(lngRowCounter, 1)).Merge
  17.             End If
  18.             If .Offset(lngRowCounter) <> "" Then
  19.                 If Not (lngRowCountLast = lngRowCounter - 1) Then
  20.                     Range(.Offset(lngRowCountLast), .Offset(lngRowCounter - 1)).Merge
  21.                     Range(.Offset(lngRowCountLast, 1), .Offset(lngRowCounter - 1, 1)).Merge
  22.                 End If
  23.                 lngRowCountLast = lngRowCounter
  24.             End If
  25.         End With
  26.     Next
  27. End Sub
½Æ»s¥N½X
À´±oµo°Ý,µª®×´N·|¦b¨ä¤¤

¤µ¤éの¤@¬íは  ©ú¤éにない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

ÁÂÁ¤j¤j¼ö¤ßªº´£¨ÑVBA

TOP

¦A½Ð°Ý¤@¤U
1.¥i§_­×§ïµ{¦¡¬°"¿ï¨úªºÀx¦s®æ½d³ò".©ÎµÛ¿ï¨úªºÄæ§O
2.©ÎµÛ¦X¨ÖÀx¦s®æ¥u¦³©T©w¤@Äæ®É  

À³¸Ó­×§ï­þ¦U¦a¤è

ÁÂÁÂ

TOP

¦^´_ 4# joey3277
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng(1 To 3) As Range, A As Range, C As Range, R As Integer
  4.     On Error Resume Next                                                   '¤£²z·|µ{§Ç¤Wªº¿ù»~,Ä~Äò°õ¦æµ{¦¡
  5.     Set Rng(1) = Application.InputBox("¿ï¨úÀx¦s®æ(¥i¿ï¦h­«½d³ò)", Type:=8) '¦p¨S¦³¿ï¨úÀx¦s®æ:µ{§Ç¤Wªº¿ù»~
  6.     If Err <> 0 Then Exit Sub                                               'µ{§Ç¤W¦³¿ù»~
  7.     On Error GoTo 0                                                         '¤£³B¸Ìµ{§Ç¤Wªº¿ù»~
  8.     For Each A In Rng(1).Areas                                              'ª«¥ó¶°¦X: Areas  (¦h­«½d³ò)
  9.         For Each C In A.Columns                                             'ª«¥ó¶°¦X: Columns(øó¦ì)
  10.             Set Rng(2) = C.Cells(1)                                         'ª«¥ó:½d³òªº,²Ä1­Ó,Àx¦s®æ¶}©l
  11.             R = C.Cells(C.Cells.Count).Row                                  '¼Æ­È :ª«¥ó½d³ò³Ì«áªºÀx¦s®æ¦C¸¹
  12.             Do
  13.                 Set Rng(3) = Rng(2).Offset(1)                               'ª«¥ó Rng(3): Rng(2)ªº¤U¤@¦CÀx¦s®æ
  14.                 Do While Rng(3) = "" And Rng(3).Row <= R                    'While(±ø¥ó¦¨¥ß,°õ¦æ°j°é):(ª«¥ó="" ¥B¶· ª«¥ó<>ª«¥ó½d³òªº³Ì«á¦C¸¹)
  15.                     Set Rng(3) = Rng(3).Offset(1)                           'ª«¥ó Rng(3): Rng(3)ªº¤U¤@¦CÀx¦s®æ
  16.                 Loop
  17.                 Rng(1).Parent.Range(Rng(2), Rng(3).Offset(-1)).Merge        'Merge(¦X¨ÖÀx¦s®æ)
  18.                 Set Rng(2) = Rng(3)                                         'ª«¥ó Rng(2): ¦³¸ê®Æ¼Æ­ÈªºÀx¦s®æ
  19.             Loop Until Rng(3).Row > R                                       'Until(±ø¥ó¤£¦¨¥ß,°õ¦æ°j°é)
  20.         Next
  21.     Next
  22. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

ÁÂÁ¤j¤jªºÀ°¦£¡I¡I»°ºò¸Õ¸Õ

TOP

½Ð±Ð¤@¤Ukimbal ¤j¤j
¨Ï¥Î§A´£¨Ñªºµ{¦¡½X¹J¨ì¤F¤@¦U°ÝÃD
¦pªG³Ì«á¤@­Ó­n¦X¨ÖªºÀx¦s®æ­n¦X¨Öªº®æ¼Æ¬O¨â®æªº¸Ü
µ{¦¡½X´N·|§ì¤£¨ì³Ì«á¤@¦U
¦p´£¨Ñªºªí¤W³Ì«á¤@®æ­n¦X¨Öªº¬O15.16.17¦C³o¨S¦³°ÝÃD
¦ý¦pªG¥u­n¦X¨Ö15.16¦C  µ{¦¡´N¥u·|°õ¦æ¨ì13¦C

PS.¥i¥t½Ð±Ð¦pªG­n¦X¨Öªº¥u¦³BÄæ
¨º§A´£¨Ñªºµ{¦¡½X­n§ï­þÃä©O?

TOP

ÁÂÁÂGBKEE ¤j¤j´£¨Ñªºµ{¦¡½X
´ú¸Õ¹L¤F   ¶W¯Å¤è«K¦n¥Î

ÁÂÁÂÀ°¦£

TOP

¦^´_ 7# joey3277
­×§ï¦p¤U
  1. Option Explicit
  2. Sub test()
  3.     Dim lngRowCount As Long, Rng As Range, R As Range
  4.     Dim lngRowCounter As Long
  5.     Dim lngRowCountLast As Long
  6.     On Error Resume Next                                                    '¤£²z·|µ{§Ç¤Wªº¿ù»~,Ä~Äò°õ¦æµ{¦¡
  7.     Set Rng = Application.InputBox("¿ï¨úÀx¦s®æ(¥i¿ï¦h­«½d³ò)", Type:=8)     '¦p¨S¦³¿ï¨úÀx¦s®æ:µ{§Ç¤Wªº¿ù»~
  8.     If Err <> 0 Then Exit Sub                                               'µ{§Ç¤W¦³¿ù»~
  9.     For Each R In Rng.Areas
  10.         lngRowCount = R.Rows.Count                                          '½d³òªºÁ`¦C¼Æ
  11.         lngRowCountLast = 1
  12.         For lngRowCounter = 2 To lngRowCount
  13.             With R.Range("A1")
  14.                 If .Offset(lngRowCounter) <> "" Or lngRowCounter = lngRowCount Then
  15.                     If Not (lngRowCountLast = lngRowCounter - 1) Then
  16.                         .Parent.Range(.Offset(lngRowCountLast), .Offset(lngRowCounter - 1)).Merge
  17.                     End If
  18.                     lngRowCountLast = lngRowCounter
  19.                 End If
  20.             End With
  21.         Next
  22.     Next
  23. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

GBKEE ¤j¤j
§AÀ°¦£­×§ïªºµ{¦¡½X  ¥X²{2¦Uª¬ªp
1.©Ò¿ï¨úªº½d³ò²Ä¤@¦U¦X¨ÖªºÀx¦s®æªº²Ä¤@¦C³£µLªk¦X¨Ö.¦p:1.2¦C­n¦X¨Ö(µL§@¥Î)¦p:1.2.3¦C­n¦X¨Ö(2.3¦C·|¦X¨Ö.¦ý¤£·|¸ò1¦C¦X¨Ö)¦p:1.2.3.4¦C­n¦X¨Ö(2.3.4·|¦X¨Ö.¦ý1¦CÁÙ¬OµLªk¤@°_¦X¨Ö)
¬O¨C¦¸­n¿ï¨ú¦X¨Ö½d³ò²Ä¤@¦U¦X¨Ö³£·|¦³³oºØ²{¶H
2.¦pªG¬OÂI¿ï¾ãÄæ´N·|³Ì«á¤@¦U¦X¨ÖÀx¦s®æµL­­¤jªº©¹¤U©µ¦ù

PS­ì¨Ókimbal ¤j¤j´£¨Ñªºµ{¦¡½X²£¥Íªº¨º¦U°ÝÃD.¦b§A­×¥¿ªºµ{¦¡½X¸Ì¤w¸Ñ¨M

¯u¤£¦n·N«ä  ¤@ª½§ä³Â·Ð:(

TOP

        ÀR«ä¦Û¦b : ­n§åµû§O¤H®É¡A¥ý·Q·Q¦Û¤v¬O§_§¹¬üµL¯Ê¡C
ªð¦^¦Cªí ¤W¤@¥DÃD