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

[µo°Ý] ¦p¦ó¥[´¡¦æ¼Æ

[µo°Ý] ¦p¦ó¥[´¡¦æ¼Æ

ªþ¥ó¤¤¡AG¦ÜJÄæ¡A·íKÄæ(¶¡¶Z)ªºµ´¹ï­È¤p©óÀx¦s®æM4¤Î¤j©óÀx¦s®æL4¡A³£¦Û°Ê¦V¤U¥[´¡¦æ¼Æ¡A±N¨C¦æ¶¡¶Z(JÄæ)³£Åܬ°¥HM4¤¤ªº³]©w¡A¶¡¶Z·|¬O»¼¼W©Î»¼´î
ºñ¦â³¡¤À¬O¥Î¤H¤â¥[´¡¡A½Ð±Ð¤j¤j¡AVBA¦p¦ó¼g¤~¥i°µ¨ì³o®ÄªG¡AÁÂÁÂ!

TEST1.rar (388.53 KB)

¥Î³o­Ó·|§ó¦n¡A§Æ±æ¦Uª©¤j¡A¥ý¶i­Ì¥i«ü±Ð¡AÁÂÁÂ!

TEST2.rar (389.07 KB)

TOP

¥»©«³Ì«á¥Ñ donod ©ó 2019-7-8 13:31 ½s¿è

§ä¤FÃö©ó"´¡¤J"ªº¤å³¹¡A¥H¤UÁÙ¬O¹F¤£¨ì®ÄªG¡A¦]¬°­n³B²z¼Æ¾Ú«Ü¦h¡AµLªk¤H¤â³B²z¡A§Æ±æ¤j¤j¥X¤â¬Û§U¡A¦AÁÂÁÂ!

ÁÂÁÂGBKEEª©¤jªº´£¨Ñ
http://forum.twbts.com/viewthrea ... ighlight=%B4%A1%A4J
¤u§@ªí¤Wªº¹w³]¨Æ¥ó(Àx¦s®æ¦³§ïÅÜ©ÒIJ°Ê¨Æ¥ó)
  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     Dim Rng As Range
  4.     Set Rng = Range("C45:H50")   '«ü©w´¡¤J·sªº¤@¦Cªº½d³ò
  5.    
  6.     If Target.Columns.Count = Rng.Columns.Count Then
  7.         'Columns.Count:¶Ç¦^½d³ò¤ºÄæ¦ìªºÁ`¼Æ
  8.         'Rows.Count:¶Ç¦^½d³ò¤º¦C¦ìªºÁ`¼Æ
  9.         If Not Intersect(Rng, Target) Is Nothing And Target.Rows.Count = 1 Then
  10.         'Intersect ¤èªk ¶Ç¦^  ***[Range ª«¥ó]***¡A¦¹ª«¥ó¥Nªí¨â­Ó©Î¦h­Ó½d³ò­«Å|ªº¯x§Î½d³ò¡C
  11.         ' Target.Rows.Count = 1  '¤@¦Cªº½d³ò
  12.             If Target.Cells(1).Column = Rng.Cells(1).Column And Target.Cells(Target.Cells.Count).Column = Rng.Cells(Rng.Cells.Count).Column Then
  13.                 'Target.Cells(1).Column = Rng.Cells(1).Column
  14.                 '´¡¤J·sªº¤@¦Cªº²Ä¤@­ÓÄ渹=«ü©w´¡¤J·sªº¤@¦Cªº½d³òªº²Ä¤@­ÓÄ渹
  15.                 'Target.Cells(Target.Cells.Count).Column = Rng.Cells(Rng.Cells.Count).Column
  16.                 '´¡¤J·sªº¤@¦Cªº³Ì«á¤@­ÓÄ渹 = «ü©w´¡¤J·sªº¤@¦Cªº½d³òªº³Ì«á¤@­ÓÄ渹
  17.                 MsgBox Target.Address
  18.             End If
  19.         End If
  20.     End If
  21. End Sub
½Æ»s¥N½X
http://forum.twbts.com/viewthread.php?tid=21219&highlight=%B4%A1%A4J
  1. Option Explicit
  2. Sub Ex()
  3.     Dim A As Range, B As Variant, i As Integer
  4.     For Each A In Range("A1", Range("A1").End(xlDown))  'A1 ©¹¤U¨ì³Ì«á¤@µ§¸ê®Æ
  5.         B = ""
  6.         For i = 1 To Len(A)
  7.             If Mid(A, i, 1) Like "[A-Z]" Then B = IIf(B = "", Mid(A, i, 1), B & "," & Mid(A, i, 1))
  8.             '§ä¨ì¤j¼gªº¦r¥À ¾É¤JÅܼÆ
  9.         Next
  10.         If B <> "" Then        '¦³§ä¨ì¤j¼gªº¦r¥À
  11.             B = Split(B, ",")  '§ä¨ì¤j¼g¦r¥Àªº°}¦C
  12.             For i = 0 To UBound(B)
  13.                 A = Replace(A, B(i), " " & B(i))  '¥[¤JªÅ®æ
  14.             Next
  15.             Do While InStr(A, Space(2))         '¥]§t¦³¨â®æªºªÅ¥Õ¦r¤¸
  16.                 A = Replace(A, Space(2), Space(1))  '®ø°£ ¨â®æªºªÅ¥Õ¦r¤¸ ¬°¤@®æªºªÅ¥Õ¦r¤¸
  17.             Loop
  18.         End If
  19.     Next
  20. End Sub
½Æ»s¥N½X

TOP

ÁÙ¥¼¦¨¥\¡A¦A½Ð¦U¦ì¤j¤j¬Û§U¡A¦AÁÂÁÂ!

TOP

½Ð°Ý¤j¤j³o­Ó¦p¦ó­×§ï¡A¤~¥i°µ¨ì­n¨D¡CÁÂÁÂ!
  1. Private Sub Command173_Click()
  2. Dim x3 As Integer
  3. x3 = [A65536].End(xlUp).Row
  4. For I = 1 To x3
  5. Do While I1 < 12
  6. Rows(I ¡Ï 1 ¡Ï i2).Insert
  7. I1 = I1 ¡Ï 1
  8. Loop
  9. i2 = i2 ¡Ï I1
  10. I1 = 0
  11. Next
  12. End Sub
½Æ»s¥N½X

TOP

G¦ÜJÄæ¡A·íKÄæ(¶¡¶Z)ªºµ´¹ï­È¤p©óÀx¦s®æM4¤Î¤j©óÀx¦s®æL4¡A³£¦Û°Ê¦V¤U¥[´¡¦æ¼Æ¡A±N¨C¦æ¶¡¶Z(JÄæ)³£Åܬ°¥HN4¤¤ªº³]©w¡A¶¡¶Z·|¬O»¼¼W©Î»¼´î
ºñ¦â³¡¤À¬O¥Î¤H¤â¥[´¡¡A½Ð±Ð¤j¤j¡AVBA¦p¦ó¼g¤~¥i°µ¨ì³o®ÄªG¡AÁÂÁÂ!

TOP

¦A§ä¤F³o­Ó°Ñ¦Ò
http://forum.twbts.com/thread-6131-1-1.html
  1. Sub FF()
  2. LastR = [A65536].End(xlUp).Row
  3. For R = LastR To 1 Step -1
  4.   If Cells(R, 1) Like "po*" Then
  5.      Cells(R + 1, 1).Insert Shift:=xlDown
  6.      Cells(R, 2).Copy Cells(R + 1, 1)
  7.   End If
  8. Next R
  9. [B:B] = ""
  10. End Sub
½Æ»s¥N½X

TOP

´_¨î¨Ã´¡¤J¯S©wªº¦æ
https://www.extendoffice.com/zh-TW/documents/excel/3682-excel-copy-and-insert-row-multiple-times.html
  1. Sub test()
  2. 'Updateby Extendoffice 20160616
  3.     Dim xCount As Integer
  4. LableNumber:
  5.     xCount = Application.InputBox("Number of Rows", "Kutools for Excel", , , , , , 1)
  6.     If xCount < 1 Then
  7.         MsgBox "the entered number of rows is error, please enter again", vbInformation, "Kutools for Excel"
  8.         GoTo LableNumber
  9.     End If
  10.     ActiveCell.EntireRow.Copy
  11.     Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(xCount, 0)).EntireRow.Insert Shift:=xlDown
  12.     Application.CutCopyMode = False
  13. End Sub
½Æ»s¥N½X

TOP

ºô¤W§ä¨ì³o­Ó
https://blog.51cto.com/hoenix/461350
"­n§â¤£连续ªº时¬q补¥R连续"
  1. Sub Macro1()
  2. For i = 2 To 5000 Step 1
  3. If Cells(i, 2) + 2 = Cells(i + 1, 2) Then  //cell(a,b) a为¦æ¡Ab为¦C
  4. Rows(i + 1).Insert
  5. Cells(i + 1, 2) = Cells(i, 2) + 1
  6. End If
  7. Next i
  8. End Sub
½Æ»s¥N½X

TOP

¤p½ú¤~²¨¾Ç²L¡A¥H¤W¦h­Ó°Ñ¦Ò¦p¦ó¾ã¦X¡A§Æ±æ¥ý¶i­ÌÀ°§U¡AÁÂÁÂ!

TOP

        ÀR«ä¦Û¦b : ¤H¥Í¨S¦³©Ò¦³Åv¡A¥u¦³¥Í©Rªº¨Ï¥ÎÅv¡C
ªð¦^¦Cªí ¤W¤@¥DÃD