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

[µo°Ý] ½Ð°ÝVBA¥i¥H°µ¨ì¨âÀɮפñ¹ï«á¦A²£¥Í¥t¤@Àɮתº¤ñ¹ïµ²ªG¶Ü?

¥»©«³Ì«á¥Ñ stillfish00 ©ó 2013-8-1 12:26 ½s¿è

¦^´_ 26# happycoccolin
¥ý±N B_0731.xlsx "§Æ±æÅã¥Ü¦b³oÄæ¦ì" ¦r¼Ë§R±¼Àx¦sÃö³¬«á¡A¦A°õ¦æ¡C
  1. Sub TEST()
  2.   Const DATABASE_NAME = "A" '¸ê®Æ®w¤u§@ªí¦WºÙ
  3.   Const DATABASE_COL = 5  'EÄæ
  4.   Const COMPARE_COL = 11  'KÄæ
  5.   
  6.   Dim d, ar, filein, fileout, s, i As Long
  7.   
  8.   Set d = CreateObject("scripting.dictionary")
  9.   ar = Sheets(DATABASE_NAME).[A1].CurrentRegion.Value
  10.   For i = 2 To UBound(ar)
  11.     d(Replace(ar(i, DATABASE_COL), "-", "")) = ar(i, 1)
  12.   Next
  13.   
  14.   filein = Application.GetOpenFilename(Title:="¿ï¾Ü­n¤ñ¹ïªºÀÉ®×")
  15.   If Not TypeName(filein) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
  16.       
  17.   Application.ScreenUpdating = False
  18.   With Workbooks.Open(filein)
  19.     ar = .Sheets(1).[A1].CurrentRegion.Value
  20.     .Close False
  21.   End With
  22.   Application.ScreenUpdating = True
  23.   
  24.   ReDim Preserve ar(LBound(ar) To UBound(ar), LBound(ar, 2) To UBound(ar, 2) + 1)
  25.   For i = LBound(ar) + 1 To UBound(ar)
  26.     s = Replace(ar(i, COMPARE_COL), "-", "")
  27.     If d.exists(s) Then
  28.       ar(i, UBound(ar, 2)) = d(s)
  29.     Else
  30.       ar(i, UBound(ar, 2)) = "No Data"
  31.     End If
  32.   Next
  33.   
  34.   fileout = Application.GetSaveAsFilename(Title:="¥t¦s¬°·sÀÉ")
  35.   If Not TypeName(fileout) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
  36.   
  37.   With Workbooks.Add.Sheets(1)
  38.     .[A1].Resize(UBound(ar), UBound(ar, 2)).Value = ar
  39.     .Parent.SaveAs fileout
  40.   End With

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

TOP

¦^´_ 25# stillfish00


    «¢Åo~~~

1.  ©Ò¥H§A§Æ±æªº¬O   ¦³§t "-"©M¨S§t"-"ªº¨â­Ó¬O¹ïÀ³¨ì¬Û¦Pµ²ªG?
      YES

2.  0730ªºÀɮפ£§t¼ÐÀY¡A0731ªº§t¼ÐÀY­þ­Ó¤~¬O¥¿½Tªº¸ê®Æ?
      0730¬O­ì¥»½Ðª©¥DÀ°¦£ªº ,¦Ó0731§t¼ÐÀY¬O«á¨Óµo²{¤ñ¹ïªºÄæ¦ì¦³¦V«á²¾¤@Äæ ¦]¦¹FINAL¬O§Æ±æ°Ñ¦Ò0731ªº¼Ë¤l

3.  ¿ï¾Ü¤ñ¹ïªº¸ê®ÆªíÄæ¦ì¤£©T©w¡A¦ý¬O­n¤ñ¹ïªº³£¬O³Ì«á¤@Äæ?
      ¤ñ¹ïªºÄæ¦ì¬O©T©wªº ¸ê®Æ®wABC.xlsx¤¤ªº"E"Äæ¦ì »P «Ý¤ñ¹ïÀÉ®×B.xlsxªº"K'Äæ¦ì¤ñ¸û
      §Æ±æ±N¤ñ¹ï«áªºµ²ªG(ABC.xlsxªº"A"Äæ¦ì¸ê®Æ)¶ñ¤J¤@­Ó¸òB.xlsx¬Û¦Pªº·sÀɮ׳̫á¤@Äæ¦ì(¥Ø«e¬O"M"Äæ)
      ²{¦bªº¼gªk­Y¶ñ¤J¸ê®Æ¬O·|Âл\­ì¥»ªºÄæ¦ì §Æ±æ¯à°÷²£¥Í¤@·sÄæ¦ì ¦Ó¤£¬O¥ÎÂл\¼g¤J

TOP

¦^´_ 24# happycoccolin
1.  ©Ò¥H§A§Æ±æªº¬O   ¦³§t "-"©M¨S§t"-"ªº¨â­Ó¬O¹ïÀ³¨ì¬Û¦Pµ²ªG?

2.  0730ªºÀɮפ£§t¼ÐÀY¡A0731ªº§t¼ÐÀY­þ­Ó¤~¬O¥¿½Tªº¸ê®Æ?

3.  ¿ï¾Ü¤ñ¹ïªº¸ê®ÆªíÄæ¦ì¤£©T©w¡A¦ý¬O­n¤ñ¹ïªº³£¬O³Ì«á¤@Äæ?

TOP

¦^´_ 23# stillfish00


   
«¢Åo~¦]¬°¦³³o¤@¬q

¤ñ¸û(¥i©¿²¤"-")

If InStr(i, "-") Then If Mid(i, InStr(i, "-"), 2) <> "-1" Then d.Remove i        '¥i©¿²¤"-"ªº¨BÆJ

©Ò¥HÀ³¸Ó­n§PÂ_¦¨"100-3".....

TOP

¦^´_ 22# happycoccolin
CAT1  ¸ê®Æ®w­ì¥»´N¨S¦³¤£¬O¶Ü?

TOP

¦^´_ 20# GBKEE


³ø§iª©¤j~«e¤@½g´y­z¤£²M·¡~§Ú­«·s´y­z¤@¤U

¥Ø«eB.xlsxªº¤ñ¹ïÄæ¦ì­n§ó°Ê¨ì"K"

¦A½Ð±Ð¬O§_¥i¥H±N¤ñ¹ï¦nªº­È¶ñ¨ì³Ì«á¤@­ÓÄæ¦ì©O?¤£­n°µÂл\¶ñ¤Wªº°Ê§@©O?

½Ð¨£ªþÀÉ~~~ÁÂÁÂ~
0731.zip (23.49 KB)

ABC.xlsx
A        B        C        D        E
100-1        XXX        XXX        XXX        DOG
100-2        XXX        XXX        XXX        CAT
100-3        XXX        XXX        XXX        CAT-1
100-4        XXX        XXX        XXX        CAT-2
                               
¡ô¤ñ¹ï§¹²¦«áShow¥X¦¹Äæ¦ì­È                ¡ô¤ñ¹ïÄæ¦ì


B.xlsx

A        B        C        D        E        F        G        H        I        J        K        L        §Æ±æÅã¥Ü¦b³oÄæ¦ì(M)
11        XX        XX        XX        1        A1        XX        XX        XX        CC        DOG        XX       
12        XX        XX        XX        2        A2        XX        XX        XX        CC        CAT        XX       
13        XX        XX        XX        2        A3        XX        XX        XX        CC        CAT1        XX       
14        XX        XX        XX        1        A4        XX        XX        XX        CC        CAT-1        XX       
15        XX        XX        XX        1        A5        XX        XX        XX        CC        CAT3        XX       
                                                                                               
                                                                                ¡ô¤ñ¹ïÄæ¦ì        ¡ô­Y¦³¦h¤@Äæ¦ì ²£¥Íªº¤ñ¹ï¸ê®Æ¬O§_¥i¦V«á¶¶©µ¨ìM©O?       
À³¸Ó»¡¬O§_¥i¦Û°Ê¶ñ¦b³Ì«á¤@Äæ©O?       

¦Ó¥B³o¦¸CAT1¨S¦³³Q¤ñ¹ï¥X¨Ó~~
ªþÀÉ
0730.zip (24.12 KB)

11        XX        XX        XX        XX        XX        XX        XX        CC        DOG        100-1
12        XX        XX        XX        XX        XX        XX        XX        CC        CAT        100-2
14        XX        XX        XX        XX        XX        XX        XX        CC        CAT-1        100-3
13        XX        XX        XX        XX        XX        XX        XX        CC        CAT1        No Data
15        XX        XX        XX        XX        XX        XX        XX        CC        CAT3        No Data

½Ðª©¤j¼·ªÅ¬Ý¬Ý¦n¶Ü~ÁÂÁÂ~!!!!

TOP

¦^´_ 20# GBKEE


    ÁÂÁª©¤j~~~¦¨¥\¤F~~

¦ý¬O¬O§_¥i¤£«ü©wÀx¦s¦ì¸m[ D:\TEXT ] ¥iÅý¨Ï¥ÎªÌ¦Û¦æ³]©wÀx¦s¦ì¸m©Î¿ï¾Ü­n¤£­n¦sÀÉ?

¦A°Ý¤@¤U¤ñ¹ïÀÉ®×B.XLSX Äæ¦ì¥Ñ"J"¦V«á¶¶©µ¬°"K"

¥u­×§ï¥H¤U«á°»¿ù¨S¦³°ÝÃD
With Wb.Sheets(1)
        Do While .Cells(i, "K") <> ""
           S = Join(Application.Transpose(Application.Transpose(.Range("A" & i & ":K" & i))), ",")
           If d.Exists(.Cells(i, "K").Value) Then
                S = S & "," & d(.Cells(i, "K").Value)
                d(.Cells(i, "K").Value) = Split(S, ",")
           Else
                d(.Cells(i, "K").Value) = Split(S & ",No Data", ",")
                S = d(.Cells(i, "K").Value)
           
           End If
            i = i + 1
        Loop
        .Parent.Close False               'Ãö³¬«ü©wÀɮפ£¦sÀÉ
    End With


¦ý¦]¬°B.xlsx¤ñ¹ïÄæ¦ì"K"«á ÁÙ¦³¤@Äæ"L"
·s²£¥ÍªºÀɮ׸ê®Æ·|¦V«á¶¶©µ¤@Äæ¶ñ¨ì"M"¶Ü?

°»¿ù²{¦b°±¦b
S = Application.Transpose(Application.Transpose(d.ITEMS))

ABC (4).zip (25.4 KB)

TOP

¦^´_ 19# happycoccolin
¥i¬O¤ñ¹ïµ²ªG³q³q³£¬ONO DATA
°ÝÃD¦b³o¸Ì
  1. With Workbooks("ABC.xlsm").Sheets(1)
  2.         '³oSheets(1) ¬OABC.xlsmªº²Ä¤@­Ó¤u§@ªí (MAIN)
  3.         '¬O§_­n§ï¦¨ Sheets(2) ->  ²Ä¤G­Ó¤u§@ªí (A)
  4.         Do While .Cells(i, "e") <> ""
  5.             d(.Cells(i, "e").Value) = .Cells(i, "A").Value
  6.             i = i + 1
  7.         Loop
  8.     End With
½Æ»s¥N½X
D:\TEST \  ³o¸ê®Æ§¨¬O§ÚÀH·N¼gªº,§A»Ý§ï¬°§APC¤¤¦s¦bªº¸ê®Æ§¨
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 18# GBKEE


    ³ø§iª©¤j~

¥Ø«e°»¿ù°±¦b
Wb.SaveAs "D:\TEST\" & Wb_Name & "XLSX"  '¦sÀɪº§¹¾ã¦WºÙ

¥i¬O¤ñ¹ïµ²ªG³q³q³£¬ONO DATA­C~

½Ð¨£ªþÀÉ
ABC3.zip (58.66 KB)

TOP

¦^´_ 17# happycoccolin
¦]¬°§Ú¤w¸g±N¸ê®Æ®w©ñ¦bABC.xlsm¸Ì­±¤F
    With Workbooks("A.xlsx").Sheets(1)   -§ï¤@¤UÀɦW  With Workbooks("ABC.xlsm").Sheets(1)
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ¦³¦h¤Ö¤O¶q´N°µ¦h¤Ö¨Æ¡A¤£­n¤ß¦sµ¥«Ý¡Aµ¥«Ý¤~·|¸¨ªÅ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD