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

[µo°Ý] Cells.Find ¦p¦óÅý§ä¤£¨ì¸ê®Æ®É´N¸õ¹L

[µo°Ý] Cells.Find ¦p¦óÅý§ä¤£¨ì¸ê®Æ®É´N¸õ¹L

¤j®a¦n

¦Û¤v¦b»s§@ªí®æ¬d¸ß®É¡A¹J¨ìCells.Findªº¥Îªk¤£ª¾¹D¦p¦ó¯à°÷¸Ñ¨M¡A
ÁٽЪ©¥»ªº¦U¦ì¯à¤£§[«ü±Ð¡AÁÂÁÂ

»¡©ú¡GªþªñexcelÀɮצ³¨â­Ó­¶­± (¬d¸ß¡BÁ`ªí)¡A·í§â¬Y¤@¨Ç§÷®Æ¸¹½X©ñ¨ì¡y¬d¸ß¡z­¶­±ªºA2-A16«á¡A
           µ{¦¡¥i¥H¥hÁ`ªí§â«á­±ªº¸ê®Æ (¥]§t¸ê®Æ¡B´À¥NÃö«Y¡B¥i¥Î¾÷«¬)¡A¶K¨ì¹ïÀ³ªºÄæ¦ì¡C

¥Ø«e¤w¸g¥i¥H°µ¬d¸ßªº¥\¯à¡A¦ý¦pªG¡y¬d¸ßªº¸ê®Æ¡z¦bÁ`ªí¤£¦s¦b´N·|¥X²{¥H¤U¿ù»~¡A
¡y°õ¦æ¶¥¬q¿ù»~ '91':¡z
¡y¨S¦³³]©wª«¥óÅܼƩÎWith°Ï¶ôÅܼơz

¦A½Ð¦U¦ì¨ó§UÀ°¦£«ü¥X°ÝÃD»P¸Ñªk¡AÁÂÁÂ
  1. Sub ´À¥N®Æªí¥Î¸ê§÷¬d¸ß220901()
  2. '
  3. Dim find_data, dat_rng, data_end, data_row, CleanFail
  4. Application.ScreenUpdating = False
  5. Sheets("¬d¸ß").Select
  6. Range("B2:BQ16").ClearContents

  7. For i = 2 To 16
  8.     If Cells(i, "A") = "" Then
  9.         Exit For
  10.     Else
  11.         find_data = Sheets("¬d¸ß").Cells(i, "A")
  12.         Cells(i, "A").Select
  13.         Sheets("Á`ªí").Select
  14.         date_end = Range(Selection, ActiveCell.SpecialCells(xlCellTypeLastCell)).Address
  15.         date_rng = "A1:" & date_end
  16.             
  17.         Cells.Find(What:=find_data, After:=ActiveCell, LookIn:=xlValues, _
  18.             LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
  19.             MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
  20.                         
  21.         Selection.End(xlToRight).Select
  22.         Selection.Copy
  23.         Sheets("¬d¸ß").Select
  24.         Cells(i, "A").Select
  25.         ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  26.                 :=False, Transpose:=False
  27.         Sheets("Á`ªí").Select
  28.         Selection.End(xlToRight).Offset(0, 1).Select
  29.         Selection.Copy
  30.         Sheets("¬d¸ß").Select
  31.         ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  32.                 :=False, Transpose:=False
  33.         Sheets("Á`ªí").Select
  34.         Selection.Offset(0, 2).Select
  35.         Range(Selection, Selection.End(xlToRight)).Copy
  36.         Sheets("¬d¸ß").Select
  37.         ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  38.                 :=False, Transpose:=False

  39.     End If

  40. Next

  41. Cells(ActiveWindow.ActivePane.ScrollRow, ActiveWindow.ActivePane.ScrollColumn).Select
  42. Application.ScreenUpdating = True

  43. End Sub
½Æ»s¥N½X

CUT.JPG (134.13 KB)

CUT.JPG

¸ÕÅç®Æªíup.rar (36.75 KB)

´À¥N

VBA ·s¤â¶i¤Æ¤¤

¦^´_ 1# JT1221

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, Brr, Crr(), i&, x&, j%
Brr = Sheets("Á`ªí").Range("a1").CurrentRegion
Arr = Sheets("¬d¸ß").Range("a1").CurrentRegion
ReDim Crr(1 To UBound(Arr), 1 To UBound(Brr, 2))
For i = 2 To UBound(Arr)
    For x = 2 To UBound(Brr)
        If Arr(i, 1) = Brr(x, 1) Then
            Crr(i - 1, 1) = Brr(x, 3): Crr(i - 1, 2) = Brr(x, 6)
            For j = 8 To UBound(Brr, 2): Crr(i - 1, j - 5) = Brr(x, j): Next
        End If
    Next
Next
Sheets("¬d¸ß").Range("b2").Resize(UBound(Arr), UBound(Brr, 2)) = Crr
End Sub

TOP

¥»©«³Ì«á¥Ñ JT1221 ©ó 2022-9-2 15:51 ½s¿è

¦^´_ 2# samwang


Hi Sam

·PÁ¦^ÂСA¬d¸ßªº¸ê®Æ§¹¥þ¥¿½T
µ{¦¡½X¤]ºë²«D±`¦h!
¦A¦¸·PÁÂ!  {:3_61:}
VBA ·s¤â¶i¤Æ¤¤

TOP

¦^´_ 1# JT1221


    ¥tÃþ¬d¸ß¤è¦¡¨Ñ«e½ú°Ñ¦Ò
ÁÂÁ«e½úµoªí¦¹©«

Option Explicit
Sub test()
Dim i, x, Arr, Brr(1 To 100000, 1 To 9), c, j, n, Crr
Arr = Sheets("Á`ªí").Range("A1").CurrentRegion
Crr = Sheets("¬d¸ß").Range("A1").CurrentRegion
c = Sheets("Á`ªí").UsedRange.Columns.Count
For i = 1 To UBound(Arr)
   For j = 8 To c
      If Trim(Arr(i, j)) = "" Or Trim(Arr(i, j)) = "A=B,A=C¡÷B=C" Then
         Exit For
         Else
            n = n + 1
            Brr(n, 8) = Trim(Arr(i, j))
            For x = 1 To 7
               Brr(n, x) = Trim(Arr(i, x))
            Next
      End If
   Next
Next
Workbooks.Add
Cells.Font.Name = "·L³n¥¿¶ÂÅé"
[A1].Resize(100000, 9) = Brr
Cells.Columns.AutoFit
Cells.Rows.AutoFit
Cells.Columns.AutoFit
[2:2].Select
ActiveWindow.FreezePanes = True
[A1].AutoFilter
[A1].Select
ActiveSheet.Name = "·sÁ`ªí"
Sheets.Add.Name = "·s¬d¸ß"
[A1].Resize(UBound(Crr), 4) = Crr
For i = 1 To UBound(Crr)
   For x = 2 To UBound(Brr)
      If Brr(x, 1) = Crr(i, 1) Then
         If Crr(i, 2) = "" Then
            Crr(i, 2) = Brr(x, 3)
         End If
         If Crr(i, 3) = "" Then
            Crr(i, 3) = Brr(x, 6)
         End If
         If Crr(i, 4) = "" Then
            Crr(i, 4) = Brr(x, 8)
            Else
               Crr(i, 4) = Crr(i, 4) & vbLf & Brr(x, 8)
         End If
      End If
   Next
Next
[A1].Resize(UBound(Crr), 4) = Crr
[A:D].Columns.AutoFit
Cells.Rows.AutoFit
Cells.Borders.LineStyle = xlContinuous
[2:2].Select
ActiveWindow.FreezePanes = True
[A1].AutoFilter
[A1].Select
End Sub

TOP

¦^´_ 4# Andy2483

    Hi Andy
         ·PÁ¦^ÂÐ¥t¥~ªº¼gªk¡A§Ú·|¦b¬ã¨s¤@¤U¼gªk!!  :handshake
VBA ·s¤â¶i¤Æ¤¤

TOP

        ÀR«ä¦Û¦b : ®É®É¦n¤ß´N¬O®É®É¦n¤é¡C
ªð¦^¦Cªí ¤W¤@¥DÃD