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

EXCEL ¦Û°Ê¥[¤Jªí®æ

EXCEL ¦Û°Ê¥[¤Jªí®æ

½Ð°Ý¦U¦ì«e½ú¡A§Ú·Q­n§Q¥Î®Ö¨ú¤è¶ô±N»Ý­nªº¤º®e¤Ä¿ï¡A¦p¹Ï1¤¤²Ä3¡B4¦C¤Ä¿ï¡AÂI¿ï¥kÃ䪺"¥[¤J¥Dªí®æ"«ö¶s«á¡A
Åý³o¨â¦Cªí®æ¤ºªº¤å¦r¦Û°Ê¥[¨ì"¥Dªí®æ"¤¤¡A½Ð°Ý¬O§_¦³¿ìªk¹ê²{©O¡H
1.png
2023-10-2 15:31

2.png
2023-10-2 15:31

¦^´_ 1# sschristy


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P±¡¹Ò
«Øij¤W¶Ç­Ó½d¨Ò
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 2# Andy2483


   ©êºp¡A½Ð°Ý¸Ó¦p¦ó¤W¶ÇEXCELÀɮסH

TOP

¦^´_ 3# sschristy


    http://forum.twbts.com/viewthread.php?tid=34&extra=page%3D1
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

·PÁ¤j¤j¦^ÂСA¥Ø«eµ¥¯Å¤´¤Ó§C¡AµLªk¶KÀɮסA·|§V¤O´£¤Éµ¥¯Å¡AÁÂÁÂ

TOP

§Ú¤]¬O¿n¤À¤£¨¬µLªkµo¤å¡A¥Ø«e¨C¤Ñ§V¤Sñ¨ì¤¤ XD

TOP

¦^´_ 1# sschristy


    ²q´ú±¡¹Ò:
¥H¿z¿ï¥X»Ý¨D¸ê®Æ¥[¤J¥Dªí®æ
20231006.zip (21.7 KB)


Option Explicit
Sub ¥[¤J¥Dªí®æ()
Dim Crr(1 To 100, 1 To 6), Q, i&, j%, A, n&
Dim sh1 As Worksheet, sh2 As Worksheet, Frng As Range
For Each Q In Worksheets
   If Q.[F1] = "«Øij¼tµP" Then Set sh1 = Q
   If Q.[G3] = "«Øij¼tµP" Then Set sh2 = Q
Next
A = Array(1, 2, 4, 5, 6)
With sh1: .Activate
   If .AutoFilter Is Nothing Then
      .[A2].AutoFilter
      With ActiveWindow
         .FreezePanes = False: .SplitRow = 1: .FreezePanes = True
      End With
   End If
   If .[B65536].End(3).Row = 1 Then MsgBox "¨S¦³¸ê®Æ": Exit Sub
   For i = 2 To .[B65536].End(3).Row
      If Rows(i).EntireRow.Hidden = True Then GoTo i02
      n = n + 1
      For j = 0 To 4
         Crr(n, A(j)) = Cells(i, j + 2)
      Next
i02: Next
End With
With sh2.[B65536].End(3)(2).Resize(n, 6)
   .Value = Crr
   sh2.Activate
   .Select
End With
Set sh1 = Nothing: Set sh2 = Nothing: Set Frng = Nothing: Erase Crr
End Sub

Sub ²M°£¶µ¥Ø()
Dim Q
For Each Q In Worksheets
   If Q.[G3] = "«Øij¼tµP" Then Q.UsedRange.Offset(3, 0).EntireRow.Delete: Exit Sub
Next
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

Public wst As String
Public j As Integer
Sub test()
Dim i As Integer
For i = 4 To 9999
If (Sheets("¥Dªí®æ").Range("A" & i) = "" And Sheets("¥Dªí®æ").Range("B" & i) = "") Then
Sheets("¥Dªí®æ").Range("B" & i) = Sheets(wst).Range("B" & j)
Sheets("¥Dªí®æ").Range("C" & i) = Sheets(wst).Range("C" & j)
Sheets("¥Dªí®æ").Range("E" & i) = Sheets(wst).Range("D" & j)
Sheets("¥Dªí®æ").Range("F" & i) = Sheets(wst).Range("E" & j)
Sheets("¥Dªí®æ").Range("G" & i) = Sheets(wst).Range("F" & j)
Exit For
Else
End If
Next i
Sheets("¥Dªí®æ").Activate
End Sub
------------------------------------------------------------------------

Private Sub CommandButton1_Click()
wst = "°Ñ¦Òªí1"
j = ActiveCell.Row
Application.Run "Module1.test"
End Sub
-------------------------------------------------------
«e½ú¤j¤j¡A³o¬O«ö¶s¤ºªºµ{¦¡½X¡A¥Ø«eªº¤è¦¡¬O³Q¿ï¨ú¨ìªº¨º¤@¦æ´N·|¦Û°Ê¥[¤J¨ì¥Dªí®æ
¦ý·Q­n§ó§ï¬°¥i¥H§å¦¸¥[¤J¡A¤£ª¾¦³¨S¦³¦n¤èªk¡AÁÂÁÂ

TOP

¦^´_ 7# Andy2483

½Æ²ß,­×¥¿»Pµù¸Ñ
Option Explicit
Sub ¥[¤J¥Dªí®æ()
Dim Crr(1 To 100, 1 To 6), Q, i&, j%, A, n&
'¡ô«Å§iCrrÅܼƬO¤Gºû°}¦CÁa¦V½d³ò1¨ì 100,¾î¦V½d³ò±q1¨ì 6
'(Q,A)¬O³q¥Î«¬ÅܼÆ,(i,n)¬Oªø¾ã¼Æ,j¬Oµu¾ã¼Æ

Dim sh1 As Worksheet, sh2 As Worksheet, Frng As Range
'¡ô«Å§i(sh1,sh2)¬O¤u§@ªíÅܼÆ,Frng¬OÀx¦s®æÅܼÆ
For Each Q In Worksheets
'¡ô³]³v¶µ°j°é!¥OQ¬O¬¡­¶Ã¯¤¤ªº¤u§@ªí
   If Q.[F1] = "«Øij¼tµP" Then Set sh1 = Q
   '¡ô¦pªG¤u§@ªí¤¤ªº[F1]Àx¦s®æ­È¬O"«Øij¼tµP"!´N¥Osh1ÅܼƬO¤u§@ªíQ
   If Q.[G3] = "«Øij¼tµP" Then Set sh2 = Q
   '¡ô¦pªG¤u§@ªí¤¤ªº[G3]Àx¦s®æ­È¬O"«Øij¼tµP"!´N¥Osh2ÅܼƬO¤u§@ªíQ
Next
A = Array(1, 2, 4, 5, 6)
'¡ô¥OAÅܼƬO¤@ºû°}¦C,0~4¯Á¤Þ¸¹°}¦C­È¨Ì§Ç¬O(1, 2, 4, 5, 6)
With sh1: .Activate
'¡ô¥H¤U¬OÃö©ó¤u§@ªísh1ªºµ{§Ç
'¡ô¥O¿E¬¡¸Ó¤u§@ªí

   If .AutoFilter Is Nothing Then
   '¡ô¦pªG¤u§@ªí¨S¦³¿z¿ïªº¥\¯à?
      .[A2].AutoFilter
      '¡ô¥O¸Óªí±q¸Óªí[A2]Àx¦s®æ«Ø¥ß¿z¿ï¥\¯à
      With ActiveWindow
      '¡ô¥H¤U¬OÃö©óµøµ¡ªºµ{§Ç
         .FreezePanes = False: .SplitRow = 1: .FreezePanes = True
         '¡ô¥O­áµ²µøµ¡¸Ñ°£,²Ä1¦C¤À³Îµøµ¡:¥O­áµ²µøµ¡
      End With
   End If
   If .[B65536].End(3).Row = 1 Then MsgBox "¨S¦³¸ê®Æ": Exit Sub
   '¡ô¦pªG¸ÓªíBÄæ³Ì«á¦³¤º®eÀx¦s®æ¦C¸¹¬O1? True´N¸õ¥X´£µøµ¡,µ²§ôµ{¦¡°õ¦æ
   For i = 2 To .[B65536].End(3).Row
   '¡ô³]¶¶°j°é!i±q2¨ì¸ÓªíBÄæ³Ì«á¦³¤º®eÀx¦s®æ¦C¸¹
      If .Rows(i).EntireRow.Hidden = True Then GoTo i02
      '¡ô¦pªG¸Ó¦C¬OÁôÂêº!´N¸õ¨ì¼Ð¥Üi02¦ì¸mÄ~Äò°õ¦æ
      n = n + 1
      '¡ô¥OnÅܼƲ֥[1
      For j = 0 To 4
      '¡ô³]¶¶°j°é!j±q0¨ì 4
         Crr(n, A(j)) = Cells(i, j + 2)
         '¡ô¥OnÅܼƦC(jÅܼÆA°}¦C­È)Ä檺Crr°}¦C­È¬OiÅܼƦCjÅܼÆ+2ÄæÀx¦s®æ­È
      Next
i02: Next
End With
With sh2.[B65536].End(3)(2).Resize(n, 6)
'¡ô¥H¤U¬OÃö©ó¤u§@ªísh2±q¤U©¹¤W§ä¨ìªºBÄæ²Ä1­ÓªÅ¥Õ®æ¦V¤UÂX®inÅܼƦC,
'¦V¥kÂX®i6ÄæÀx¦s®æªºµ{§Ç

   .Value = Crr
   '¡ô¥OÀx¦s®æ­È¥HCrr°}¦C­È±a¤J
   sh2.Activate
   '¡ô¥O¿E¬¡¤u§@ªí
   .Select
   '¡ô¥O¿ï¨ú¸Ó½d³òÀx¦s®æ
End With
Set sh1 = Nothing: Set sh2 = Nothing: Set Frng = Nothing: Erase Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub

Sub ²M°£¶µ¥Ø()
Dim Q
For Each Q In Worksheets
   If Q.[G3] = "«Øij¼tµP" Then Q.UsedRange.Offset(3, 0).EntireRow.Delete: Exit Sub
Next
'¡ô¥Oµ²ªGªí²M°£²Ä3¦C¥H«áªº¸ê®Æ(§t)
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-10-14 12:44 ½s¿è

¦^´_ 8# sschristy


    '¥H¤U¬O°Ñ¦Òªí1 ¿ï¨ú¦h¦C §å¦¸¥[¤Jªº«Øij¤è®×
Private Sub CommandButton1_Click()
Dim Q, A(10000), i&, n&
wst = "°Ñ¦Òªí1"
For Each Q In Split(Selection.Cells.EntireRow.Address(0, 0), ",")
   For i = 0 To -Evaluate(Replace(Q, ":", "-"))
      A(n) = Val(Q) + i
      n = n + 1
   Next
Next
For i = 0 To n - 1
   j = A(i)
   Application.Run "Module1.test"
Next
Sheets("¥Dªí®æ").Activate
End Sub

20231014.zip (30.85 KB)
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¦³Ä@©ñ¦b¤ß¸Ì¡A¨S¦³¨­Åé¤O¦æ¡A¥¿¦p¯Ñ¥Ð¤£¼½ºØ¡A¬Ò¬OªÅ¹L¦]½t¡C
ªð¦^¦Cªí ¤W¤@¥DÃD