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

[µo°Ý] ¤£³W«h¸ê®Æ¡A¦p¦ó­«¾ã.....

¦^´_ 10# lpk187

Á`ºâ¤F¸Ñ·N«ä¤F
ÁÂÁ¤j¤jºëÅPªº¸Ñ»¡
¤SÂç²M¤F§ó¦hªºÆ[©À¤F

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-12-4 08:54 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:


°õ¦æµ²ªG:



Option Explicit
Sub TEST()
Dim Brr, Crr, i&, j%, R&, T$
'¡ô«Å§iÅܼÆ
Brr = Intersect(ActiveSheet.UsedRange, [A:K])
'¡ô¥OBrrÅܼƬO ¸Ë²±«ü©wÀx¦s®æ­Èªº¤Gºû°}¦C
ReDim Crr(1 To 1000, 1 To 4)
'¡ô«Å§iCrrÅܼƬO¤Gºû ªÅ°}¦C
For i = 3 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q3¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   If T <> Trim(Brr(i, 1)) And Trim(Brr(i, 1)) <> "" Then T = Trim(Brr(i, 1))
   '¡ô¦pªGTÅܼƻP i°j°é¦C²Ä1ÄæBrr°}¦C­È(¥B¤£¬OªÅ­È)¤£¦P??´N¥OT¬O¸Ó­È
   If Val(Brr(i, 10)) = 0 Then GoTo i01 Else R = R + 1: Crr(R, 1) = T
   '¡ô¦pªGi°j°é¦C²Ä10ÄæBrr°}¦C­ÈÂà­¼ªº¼Æ­È¬O0?? ´N¸õ¨ì¼Ð¥Ü i01¦ì¸mÄ~Äò°õ¦æ,
   '§_«h´N¥ORÅܼƲ֥[1,¥ORÅܼƦC²Ä1ÄæCrr°}¦C­È¬O TÅܼÆ

   For j = 3 To 9
   '¡ô³]¶¶°j°é!j±q3¨ì9
      If Trim(Brr(i, j)) <> "" Then
      '¡ô¦pªG³vÄæ§P©w¨ä­È¤£¬OªÅ­È
         Crr(R, 2) = Brr(2, j)
         '¡ô¥O²Ä2ÄæCrr°}¦C­È¥HBrr°}¦C²Ä2¦C²Äj°j°éÄæ­È±a¤J
         Crr(R, 3) = Brr(i, j)
         '¡ô¥O²Ä3ÄæCrr°}¦C­È¥HBrr°}¦C²Äi°j°é¦C²Äj°j°éÄæ­È±a¤J
         Crr(R, 4) = Brr(i, 10)
         '¡ô¥O²Ä4ÄæCrr°}¦C­È¥HBrr°}¦C²Äi°j°é¦C²Ä10Äæ­È±a¤J
         Exit For
         '¡ô¥O¸õ¥XjÅܼƪº°j°é
      End If
   Next
i01: Next
[R:U].ClearContents
'¡ô¥Oµ²ªGÄ椺®e²M°£
If R = 0 Then Exit Sub
'¡ô¦pªGRÅܼƬO 0(¥Nªí¨S¦³²Å¦Xªº¸ê®Æ),´Nµ²§ôµ{¦¡°õ¦æ
[R3].Resize(R, 4) = Crr
'¡ô¥O«ü©wÀx¦s®æÂX®i­è¦nªº½d³òÀx¦s®æ­È¥HCrr°}¦C­È±a¤J
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

(¿é¤J½s¸¹12096) googleºô§}:https://hcm19522.blogspot.com/
google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

¥»©«³Ì«á¥Ñ singo1232001 ©ó 2023-12-8 09:35 ½s¿è

Sub t5()
I = Split("Provider=Microsoft.,Jet.OLEDB.4,.0;Extended Properties=Excel ,8,.0;Data Source=", ",")
If Application.Version > 12 Then I(1) = "ACE.OLEDB.12": I(3) = 12
Set cn = CreateObject("adodb.connection"): cn.Open Join(I, "") & ThisWorkbook.FullName
q = "select F1,left(B,1),B,I from( select F1,F3&F4&F5&F6&F7&F8&F9 "
q = q & "as B,I FROM [" & ActiveSheet.Name & "$A1:K] where I is not NULL)"
[S:V].ClearContents: [s3].CopyFromRecordset cn.Execute(q)
For Each Z In [s3].CurrentRegion
If Z.Value = "" Then Z.Value = Z.Offset(-1, 0)
Next
End Sub

TOP

        ÀR«ä¦Û¦b : ¤H­nª¾ºÖ¡B±¤ºÖ¡B¦A³yºÖ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD