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

mdr0465

¦U¦ì¤j¤j,

½Ð°Ý§Ú¦³¤@­ÓÁ`±b¬O©Ò¦³¸ê®Æ³£Âk¯Ç¦b¤@­Ó¤u§@ªí, ¦ý§Ú·Q«ö·Ó¤£¦Pªº½s¸¹(¬A¸¹¤ºªº¼Æ¦r)½Æ»s¦b¥t¤@¤u§@ªí©M¥[¤W©T©wªº¶µ¥Ø¦Wµ¥ºÙ, ¨C¤@­Ó¬ì¥Ø¤§¶¡³£·|¦³¤@¦æªÅ¶¡¬Û¹j,

ÁÂÁÂ

singo1232001

¦^´_ 14# Andy2483


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

Andy2483

¦^´_ 13# singo1232001


    ÁÂÁ«e½ú
½Ð±Ð«e½ú:
¬O¤£¬O­n¾Ç¹LSQL¡B¸ê®Æ®w,¤~¯à¤F¸Ñ¦¹µ{¦¡½Xªº·N«ä?
ÁÂÁ«e½ú¸Ñ´b

singo1232001

¦^´_ 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

mdr0465

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

Andy2483

¦^´_ 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

lee88

¦^´_ 9# Andy2483
¥i·b¼¯¤@¤U

1. Option Explicit
   
2. Sub TEST()
   
3. Dim Sh As Worksheet, Rng As Range, i As Integer
   
4.     Set Sh = Sheets("¤ÀÃþ±b")
   
5.     With Sheets("µ²ªG")
   
6.         .Cells.Clear
   
7.         Set Rng = .[a1]
   
8.         Sh.Range("A:A").AdvancedFilter xlFilterCopy, , .[Z1], True  '
   
9.          Sh.Range("A1,d1").Copy .[aa1]
   
10.         .[ab2] = "=" & """<>" & "    ¥» ¤é ¦X ­p"""                        '¶ñ[ºK­n]¤J·Ç«h ±ø¥ó
    
11.         i = 2
    
12.         Do While .[Z1].Cells(i) <> ""
    
13.             .Range("aa2," & Rng.Address) = .[Z1].Cells(i)            '
    
14.             Sh.Range("B1:H1").Copy Rng.Cells(2)
    
15.             Sh.Range("a:H").AdvancedFilter xlFilterCopy, .[aa1:ab2], Rng.Cells(2).Resize(1, 7)    '¶i¶¥¿z¿ï'
    
16.             Set Rng = Rng.End(xlDown).Offset(2)         
    
17.             i = i + 1
    
18.         Loop
    
19.     End With
    
20. End Sub

½Æ»s¥N½X

Andy2483

¦^´_ 7# lee88


    ÁÂÁ«e½ú«ü¾É
«á¾Ç¤µ¤Ñ½m²ß±NRng(1 To 5) As Range ¥ÎY¦r¨å¸Ë²±

°õ¦æµ²ªG:

¤U¸ü (213.28 KB)

2022-12-29 10:09

»²§UÄæ:

¤U¸ü (188.91 KB)

2022-12-29 10:09

Option Explicit
Sub ¶µ¬Û¤ÀÃþ­«¾ã_20221229_1()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim i&, Y
Set Y = CreateObject("Scripting.Dictionary")
Set Y(1) = Sheets("¤ÀÃþ±b").Range("A1").CurrentRegion
With Sheets("µ²ªG")
   .Cells.Clear
   Set Y(2) = .[Z1]
   '¦s©ñ©ú²Ó¬ì¥Ø_¹ô§OÄd ¤£­«´_ªº¶µ¥Ø
   Set Y(5) = .[A1]
   '¦s©ñ¨C¦¸¿z¿ïªº¦ì¸m
End With
Y(1).Range("A1").Copy Y(2)
Y(1).AdvancedFilter xlFilterCopy, Y(2).Cells.Resize(2), Y(2), True
' "©ú²Ó¬ì¥Ø_¹ô§O"¿z¿ï¤£­«´_ªº¶µ¥Ø
Set Y(3) = Y(2).Offset(, 1)
'¿z¿ïªº·Ç«h½d³ò
Y(1).Range("A1,D1").Copy Y(3)
'·Ç«hªºÄæ¦ì
Set Y(4) = Y(3).Offset(, 3)
'«ü©w³Q½Æ»s¦Cªº¥Ø¼Ð½d³ò
Y(3).Range("B2") = "=" & """<>" & "    ¥» ¤é ¦X ­p"""
'¶ñ[ºK­n]¤J·Ç«h ±ø¥ó
i = 2
Do While Y(2).Cells(i) <> ""
   Y(4).CurrentRegion.Clear
   Y(3).Range("A2") = Y(2).Cells(i)
   '¶ñ¤J[©ú²Ó¬ì¥Ø_¹ô§O]·Ç«h±ø¥ó
   Y(1).AdvancedFilter xlFilterCopy, Y(3).Resize(2, 2), Y(4)
   '¶i¶¥¿z¿ï'
   Y(5).Value = Y(2).Cells(i).Value
   '¼ÐÀY ¿z¿ïªº[©ú²Ó¬ì¥Ø_¹ô§O]
   Y(4).CurrentRegion.Offset(, 1).Copy Y(5).Offset(1)
   '¸ê®Æªº½d³ò .Offset(, 1) ¦V¥k²¾°Ê¤@Äd **¤£»Ý­n [©ú²Ó¬ì¥Ø_¹ô§O]Äæ
   Set Y(5) = Y(5).End(xlDown).Offset(2)
   i = i + 1
Loop
End Sub

Andy2483

¦^´_ 7# lee88


    ÁÂÁ«e½ú«ü¾É
«á¾Ç¬O¿ý»s¥¨¶°¾Ç°_ªº,³£¥H²´¨£¬°¾Ì­×§ï¥¨¶°¥H²Å¦X»Ý¨D,¤£ª¾¹D¥i¥H³o¼Ë¹B¥Î
¥ýÁÂÁ«e½ú«ü¾É,«á¾Ç¨Ì´`«e½úµù¸Ñ¬ã¨s¬Ý¬Ý
°õ¦æµ²ªG:

¤U¸ü (213.28 KB)

2022-12-28 16:12

lee88

¦^´_ 5# Andy2483
¸Õ¸Õ¶i¶¥¿z¿ï

1. Option Explicit
   
2. Dim Rng(1 To 5) As Range
   
3. Sub ¶µ¬Û¤ÀÃþ­«¾ã()
   
4.     ³]©w
   
5.     ¶i¶¥¿z¿ï
   
6. End Sub
   
7. Private Sub ³]©w()
   
8.     Set Rng(1) = Sheets("¤ÀÃþ±b").Range("A1").CurrentRegion
   
9.     With Sheets("µ²ªG")
   
10.         .Cells.Clear
    
11.         Set Rng(2) = .[Z1]   '¦s©ñ©ú²Ó¬ì¥Ø_¹ô§OÄd ¤£­«´_ªº¶µ¥Ø
    
12.         Set Rng(5) = .[A1]  '¦s©ñ¨C¦¸¿z¿ïªº¦ì¸m
    
13.     End With
    
14.     Rng(1).Range("A1").Copy Rng(2)
    
15.     Rng(1).AdvancedFilter xlFilterCopy, Rng(2).Cells.Resize(2), Rng(2), True ' "©ú²Ó¬ì¥Ø_¹ô§O"¿z¿ï¤£­«´_ªº¶µ¥Ø
    
16.     Set Rng(3) = Rng(2).Offset(, 1)                 '¿z¿ïªº·Ç«h½d³ò
    
17.      Rng(1).Range("A1,D1").Copy Rng(3)    '·Ç«hªºÄæ¦ì
    
18.     Set Rng(4) = Rng(3).Offset(, 3)                 '«ü©w³Q½Æ»s¦Cªº¥Ø¼Ð½d³ò
    
19. End Sub
    
20. Private Sub ¶i¶¥¿z¿ï()
    
21.     Dim i As Integer, R As Range
    
22.     Rng(3).Range("B2") = "=" & """<>" & "    ¥» ¤é ¦X ­p"""                         '¶ñ[ºK­n]¤J·Ç«h ±ø¥ó
    
23.     i = 2
    
24.     Do While Rng(2).Cells(i) <> ""
    
25.         Rng(4).CurrentRegion.Clear
    
26.         Rng(3).Range("A2") = Rng(2).Cells(i)                                                        '¶ñ¤J[©ú²Ó¬ì¥Ø_¹ô§O]·Ç«h±ø¥ó
    
27.         Rng(1).AdvancedFilter xlFilterCopy, Rng(3).Resize(2, 2), Rng(4)      '¶i¶¥¿z¿ï'
    
28.         Rng(5) = Rng(2).Cells(i).Value                                                                     '¼ÐÀY ¿z¿ïªº[©ú²Ó¬ì¥Ø_¹ô§O]
    
29.         Rng(4).CurrentRegion.Offset(, 1).Copy Rng(5).Offset(1)                   '¸ê®Æªº½d³ò .Offset(, 1) ¦V¥k²¾°Ê¤@Äd **¤£»Ý­n [©ú²Ó¬ì¥Ø_¹ô§O]Äæ
    
30.         Set Rng(5) = Rng(5).End(xlDown).Offset(2)
    
31.         i = i + 1
    
32.     Loop
    
33. End Sub

½Æ»s¥N½X