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

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

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

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

¦^´_ 22# happycoccolin
CAT1  ¸ê®Æ®w­ì¥»´N¨S¦³¤£¬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

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

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

¥»©«³Ì«á¥Ñ 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

¦^´_ 27# stillfish00


    ÁÂÁÂstillfish00~~~~

§Ú¨Órun¤@¤U~·P®¦±zªºÀ°¦£~~

TOP

¦^´_ 27# stillfish00


    «¢Åo~~stillfish00 ~~^^

­è­è¸Õ¹LOK~

¦ý¬O¦³´X­Ó°ÝÃD

1.­Y¸ê®Æ®w¤¤¦³ªÅ¥Õ¦æ,´N·|°±¤î¤ñ¹ï ¾É­PB.xlsx³Ì«á¤@­Ó»P¸ê®Æ®w¹ïÀ³ªºÄæ¦ì¤U¤@¦æ¬ÒÅܦ¨NO DATA
(¥Ø«e¸ê®Æ®w¹w­p¦³50000¦æ¥ª¥kªº¸ê®Æ) ­è­è¦³¥ý©ñ¶i¥h¤ñ¹ïµo²{µ²ªG³q³q³£¬ONO DATA

ABC_0801.zip (30.21 KB)

2.¬O§_¥i¥HÅýuser¿ï¾Ü¦sÀÉ»P§_ ¤£­nª½±µ¥ý¸õ¥X¦sÀɪºµøµ¡©O?
p.s.¥Ø«eÀx¦sªºÀɮ׬O¨S¦³ÀÉ®×Ãþ«¬ªº

3.¬O§_¥iÅý¤ñ¹ï¦nªºÀɮ׸ê®Æ¦³®æ½u¤Î¦Û°Ê½Õ¾ãÄæ¼e?¥i³]©w¦r«¬»P¤j¤p¶Ü?


©êºp°ÝÃD«Ü¦h~«ô°U«ô°U~~~~~~~

TOP

¦^´_ 29# happycoccolin
  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.   With Sheets(DATABASE_NAME)
  10.     ar = .[A1].CurrentRegion.Resize(.Cells(.Rows.Count, "A").End(xlUp).Row).Value
  11.   End With
  12.   For i = 2 To UBound(ar)
  13.     d(Replace(ar(i, DATABASE_COL), "-", "")) = ar(i, 1)
  14.   Next
  15.   
  16.   filein = Application.GetOpenFilename(FileFilter:="Excel ¬¡­¶Ã¯ (*.xlsx),*.xlsx", Title:="¿ï¾Ü­n¤ñ¹ïªºÀÉ®×")
  17.   If Not TypeName(filein) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
  18.       
  19.   Application.ScreenUpdating = False
  20.   With Workbooks.Open(filein).Sheets(1)
  21.     ar = .[A1].CurrentRegion.Resize(.Cells(.Rows.Count, "A").End(xlUp).Row).Value
  22.     .Parent.Close False
  23.   End With
  24.   Application.ScreenUpdating = True
  25.   
  26.   ReDim Preserve ar(LBound(ar) To UBound(ar), LBound(ar, 2) To UBound(ar, 2) + 1)
  27.   For i = LBound(ar) + 1 To UBound(ar)
  28.     s = Replace(ar(i, COMPARE_COL), "-", "")
  29.     If d.exists(s) Then
  30.       ar(i, UBound(ar, 2)) = d(s)
  31.     Else
  32.       ar(i, UBound(ar, 2)) = "No Data"
  33.     End If
  34.   Next
  35.   
  36.   With Workbooks.Add
  37.     Application.ScreenUpdating = False
  38.     With .Sheets(1).[A1].Resize(UBound(ar), UBound(ar, 2))
  39.       .Value = ar
  40.       .Font.Name = "Verdana"  '¦rÅé¦WºÙ
  41.       .Font.Size = 14 '¦rÅé¤j¤p
  42.       .Borders.LineStyle = xlContinuous '®Ø½u
  43.       .EntireColumn.AutoFit '½Õ¾ãÄæ¼e
  44.       
  45.       .Rows(1).Interior.Color = 12567966  '¼ÐÀYÃC¦â
  46.       .Rows(1).Font.Bold = True  '¼ÐÀY²ÊÅé¦r
  47.     End With
  48.     Application.ScreenUpdating = True
  49.    
  50.     If MsgBox("¬O§_­nÀx¦sÀÉ®×?", vbYesNo) = vbYes Then
  51.       fileout = Application.GetSaveAsFilename(FileFilter:="Excel ¬¡­¶Ã¯ (*.xlsx),*.xlsx", Title:="¥t¦s¬°·sÀÉ")
  52.       If Not TypeName(fileout) = "String" Then Exit Sub '¨ú®ø«hµ²§ô
  53.       .SaveAs fileout, FileFormat:=xlWorkbookDefault
  54.     End If
  55.   End With
  56. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ¡i®É¶¡µLªk¾B¾×¡j©È®É¶¡®ø³u¡Aªá¤F³\¦h¤ß¦å¡A·QºÉ¦U¦¡¤èªk­n¾B¾×®É¶¡¡Aµ²ªG¬O¡G®ö¶O¤F§ó¦h®É¶¡¡A¥B¤@µL©Ò¦¨¡I
ªð¦^¦Cªí ¤W¤@¥DÃD