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

[µo°Ý] ¶µ¬Û¤ÀÃþ­«¾ã

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-12-30 09:38 ½s¿è

¦^´_ 10# lee88


    ÁÂÁ«e½ú
¾Ç²ß¨ì¦hÄæÀx¦s®æ¶i¶¥¿z¿ïªº¤èªk,¤ß±oµù¸Ñ¦p¤U:

Option Explicit
Sub TEST_lee88()
Dim Sh As Worksheet, Rng As Range, i As Integer
'¡ô«Å§iÅܼÆ:Sh¬O ¤u§@ªíÅܼÆ,Rng¬O Àx¦s®æÅܼÆ,i¬O µu¾ã¼Æ
Set Sh = Sheets("¤ÀÃþ±b")
'¡ô¥OSh¬O "¤ÀÃþ±b"¤u§@ªí
With Sheets("µ²ªG")
'¡ô¥H¤U¬OÃö©ó "µ²ªG"¤u§@ªíªºµ{§Ç
   .Cells.Clear
   '¡ô²M°£¥þ³¡¤u§@ªí
   Set Rng = .[a1]
   '¡ô¥ORng¬O "µ²ªG"¤u§@ªíªº[A1]Àx¦s®æ
   Sh.Range("A:A").AdvancedFilter xlFilterCopy, , .[Z1], True
   '¡ô¥O"¤ÀÃþ±b"¤u§@ªí AÄæ°µ¶i¶¥¿z¿ï¨ì "µ²ªG"¤u§@ªíªº[Z1]Àx¦s®æ
   'https://learn.microsoft.com/zh-tw/office/vba/api/excel.range.advancedfilter
   Sh.Range("A1,d1").Copy .[aa1]
   '¡ô¥O"¤ÀÃþ±b"¤u§@ªí[A1,D1]Àx¦s®æ¶°½Æ»s¨ì "µ²ªG"¤u§@ªíªº[AA1]Àx¦s®æ
   .[ab2] = "=" & """<>" & "    ¥» ¤é ¦X ­p"""
   '¶ñ[ºK­n]¤J·Ç«h ±ø¥ó
   '¡ô¥O"µ²ªG"¤u§@ªíªº[AB2]Àx¦s®æ­È¬O ¤½¦¡:="<>    ¥» ¤é ¦X ­p"

   i = 2
   '¡ô¥Oi³oµu¾ã¼Æ¬O 2
   Do While .[Z1].Cells(i) <> ""
   '¡ô³]µL½u°j°é!·í "µ²ªG"¤u§@ªíªº[Z1]Àx¦s®æ¦V¤UiÅܼƮ檺Àx¦s®æ­È¤£¬O ""ªÅ¦r¤¸,³o±ø¥ó¤U´NÄ~Äò°õ¦æ
   'https://learn.microsoft.com/zh-tw/dotnet/visual-basic/language-reference/statements/do-loop-statement

      .Range("aa2," & Rng.Address) = .[Z1].Cells(i)
      '¡ô¥O[AA2]»PRngÀx¦s®æÅܼƳo¨â­Ó Àx¦s®æ­È¬O "µ²ªG"¤u§@ªíªº[Z1]Àx¦s®æ¦V¤UiÅܼƮ檺Àx¦s®æ­È
       Sh.Range("B1:H1").Copy Rng.Cells(2)
       '¡ô¥O"¤ÀÃþ±b"¤u§@ªí[B1:H1]Àx¦s®æ½Æ»s¨ì RngÀx¦s®æÅܼƪº¤U¤@®æ
       Sh.Range("a:H").AdvancedFilter xlFilterCopy, .[aa1:ab2], Rng.Cells(2).Resize(1, 7)
       '¶i¶¥¿z¿ï
       '¡ô¥O"¤ÀÃþ±b"¤u§@ªí[A:H]Àx¦s®æ°µ ¶i¶¥¿z¿ï:
       '·Ç«h1:©ú²Ó¬ì¥Ø_¹ô§O¬OZÄæ¦U­ÓiÅܼƶµ¥Ø
       '·Ç«h2:ºK­n "<>    ¥» ¤é ¦X ­p"

       Set Rng = Rng.End(xlDown).Offset(2)
       '¡ô¥ORng³oÀx¦s®æÅܼƬO¦Û¨­Àx¦s®æ©¹¤U±´¨ìªº³Ì«á¦³¤º®eÀx¦s®æ¦A©¹¤UÃä²¾2®æªºÀx¦s®æ
       i = i + 1
   Loop
End With
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 11# Andy2483
¦hÁ¨â¦ì½úªº±x¤ß±Ð¾É, ÁÂÁÂ

TOP

¦^´_ 12# mdr0465


    ·PÁ­ɦ¹ÃD½m²ß ªþ¤WÀÉ®×

Sub ¤ÀÃþ()
With CreateObject("adodb.connection"): V = Application.Version:
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0; "
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0; "
.Open V & "Data Source=" & ThisWorkbook.FullName
Set s = Sheets("µ²ªG"): Set s1 = Sheets("¤ÀÃþ±b")
ar = s1.Range("b1:H1")
tx = Join(Application.Index(ar, 1, 0), ",")
Set rs = .Execute("select distinct " & s1.[A1] & " from [¤ÀÃþ±b$A1:A]")
rr = rs.getrows(, , "©ú²Ó¬ì¥Ø_¹ô§O")
s.Cells.ClearContents
For Each Z In rr
r = s.Cells(Rows.Count, 1).End(3).Row + 2
s.Cells(r, 1) = Z
s.Cells(r + 1, 1).Resize(1, UBound(ar, 2)) = ar
q = "select " & tx & " from [¤ÀÃþ±b$A1:H] where ©ú²Ó¬ì¥Ø_¹ô§O = '" & Z & "' and ºK­n not like '%¥»%¤é%¦X%­p%' and ºK­n not like '%¥»%¦~%²Ö%­p%'"
s.Cells(r + 2, 1).CopyFromRecordset .Execute(q)
Next
s.Rows("1:2").Delete Shift:=xlUp
r = s.Cells(Rows.Count, 1).End(3).Row
s.Cells(1, 1).Resize(r, 7).Borders.LineStyle = 1
End With
End Sub

¤ÀÃþ±b.zip (176.6 KB)

TOP

¦^´_ 13# singo1232001


    ÁÂÁ«e½ú
½Ð±Ð«e½ú:
¬O¤£¬O­n¾Ç¹LSQL¡B¸ê®Æ®w,¤~¯à¤F¸Ñ¦¹µ{¦¡½Xªº·N«ä?
ÁÂÁ«e½ú¸Ñ´b
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 14# Andy2483


    ¬Oªº
¥Îvba ½Õ¥Îsql¨Ó³B²zexcel¬Y¨Ç¸ê®Æ¾ã²zªº°ÝÃD

TOP

        ÀR«ä¦Û¦b : °ß¨ä´L­«¦Û¤vªº¤H¡A¤~§ó«i©óÁY¤p¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD